#  AuthDB.pm -- Facilitate access to Apache 'AuthDB' files.

use DB_File;

my $DBFILE  = '/usr/local/apache/etc/htpasswd';

my $LOCK_SH = 1;
my $LOCK_EX = 2;
my $LOCK_UN = 8;

#   Pass this method a username, and if a record for the user exists,
#   it will return the record in the form of a reference to a hash.
#   If the database can't be read (it might be new and thus empty)
#   or the user record does not exist, it will return 0.

sub authdb_get {
    my $username = shift;
    my ($db, %db, $fd);
    my $retval = 0;
    my $record;
    my %hash;
    my $password;

    $db = tie %db, "DB_File", $DBFILE, O_RDONLY, 0644;
    $fd = $db->fd;
    open(DB_FH, "<&=$fd") || die "Could not get filehandle. $!";
    flock(DB_FH, $LOCK_SH); # wait for a read lock

    if ($db && ($record = $db{$username})) {

      ($password, @_) = split(/:/, $record);

      foreach (@_) {
          my ($k,$v) = split /=/;
          $hash{$k} = unescape($v);
      }

      $hash{"password"} = $password;
      $retval = \%hash;

    } else {
      warn "Warning: $username not found in '$DBFILE' $!";
    }

    flock(DB_FH, $LOCK_UN); # release the lock
    close DB_FH;
    untie %db;

    return $retval;
}

#   Pass this method a username, encrypted password, groups,
#   and a hash containing additional data and it will
#   write a record to the database file.

sub authdb_put {
    my ($username, $password, %hash) = @_;
    my ($db, %db);
    my $record;
    my ($k,$v);

    $db = tie %db, "DB_File", $DBFILE, O_RDWR|O_CREAT;
    if ($db) {
      my $fd = $db->fd;
      open(DB_FH, "+<&=$fd") || die "Could not get filehandle. $!";
      flock(DB_FH, $LOCK_EX); # wait for a lock

      $username =~ s/://g; # strip out delimiters
      $record = $password;

      # Append the contents of the hash into the 'extras' area.

      while (($k,$v) = each(%hash)) {
          $k =~ s/[:=]//g; # strip out delimiters
          $record .= ":$k=" . escape($v);
      }

      $db{$username} = $record;
      $db->sync;

      flock(DB_FH, $LOCK_UN); # release the lock
      close DB_FH;

    } else {
      warn "Warning: write failed $username to '$DBFILE' $!";
    }
    untie %db;
}

# Given a valid username, delete the record.
# Return status.

sub authdb_delete {
    my $username = shift;
    my $status = 0;
    my ($db, %db);

    $db = tie %db, "DB_File", $DBFILE, O_RDWR;
    if ($db && $db{$username}) {
      my $fd = $db->fd;
      open(DB_FH, "+<&=$fd") || die "Could not get filehandle. $!";
      flock(DB_FH, $LOCK_EX); # wait for a lock

      delete $db{$username};
      $db->sync;
      flock(DB_FH, $LOCK_UN); # release the lock
      close DB_FH;

      $status = 1;
    } else {
      warn "Warning: delete failed $username in '$DBFILE' $!";
    }
    untie %db;
    return $status;
}

# that's all!
# Generate a new 2 character salt for crypt().
sub salt {
    my @chars = ("A".."Z", "a".."z", 0..9, '.', '/');
    return join('', @chars[ map{rand @chars} (1..2) ]);
}

# escape our delimiter characters by converting them to hex
sub escape {
    my $r = shift;
    $r =~ s/%/%25/g;  # %
    $r =~ s/:/%3A/g;  # :
    $r =~ s/=/%3D/g;  # =
    return $r;
}

# unescape delimiters by converting from hex to ASCII
sub unescape {
    my $r = shift;
    $r =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
    return $r;
}

1;