httpd-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Doug MacEachern <do...@hyperreal.org>
Subject cvs commit: apache/support dbmmanage dbmmanage.readme dbmmanage.new
Date Sat, 02 Aug 1997 22:42:28 GMT
dougm       97/08/02 15:42:27

  Modified:    support   dbmmanage dbmmanage.readme
  Removed:     support   dbmmanage.new
  Log:
  dbmmanage overhaul (see CHANGES)
  removed dbmmanage.new
  updated dbmmanage.readme
  
  Submitted by:	Doug MacEachern
  Reviewed by:	Dean Gaudet, Randy Terbush, Marc Slemko
  
  Revision  Changes    Path
  1.7       +128 -70   apache/support/dbmmanage
  
  Index: dbmmanage
  ===================================================================
  RCS file: /export/home/cvs/apache/support/dbmmanage,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- dbmmanage	1997/01/01 18:26:15	1.6
  +++ dbmmanage	1997/08/02 22:42:24	1.7
  @@ -50,77 +50,135 @@
   # For more information on the Apache Group and the Apache HTTP server
   # project, please see <http://www.apache.org/>.
   
  -
  -# usage: dbmmanage <DBMfile> <command> <key> <value> <group>
  -#
  -# commands: add, delete, view, adduser
  +#for more functionality see the HTTPD::UserAdmin module:
  +# http://www.perl.com/CPAN/modules/by-module/HTTPD/HTTPD-Tools-x.xx.tar.gz
   #
  -# no values needed for delete, no keys or values needed for view.
  -# to change a value, simply use "add".
  -# adduser encrypts the password:
  -# dbmmanage <dbm file> adduser <person> <password>
  -#
  -# <group> is optional, and may also be supplied to add the user
  -# to a specified group:
  -# dbmmanage <dbm file> adduser <person> <password> <group>
  -
  -if (scalar(@ARGV) < 2) {
  -	print "Too few arguments.\n";
  -	exit;
  -}
  -
  -$file=$ARGV[0];
  -$command=$ARGV[1];
  -$key=$ARGV[2];
  -$value=$ARGV[3];
  -$group=$ARGV[4];
  -
  -# create a random salt
  -@range=('0'..'9','a'..'z','A'..'Z');
  -srand($$|time);
  -$salt=$range[rand(int($#range)+1)] . $range[rand(int($#range)+1)];
  -
  -if ($command eq "add") {
  -        dbmopen(%DB, $file, 0664) || die "Error: $!\n";
  -        $value .= ":$group" if $group ne "";
  -        $DB{$key} = $value;
  -        dbmclose(%DB);
  -	print "Entry $key added with value $value.\n";
  -	exit;
  -}
  -
  -if ($command eq "adduser") {
  -	$hash = crypt($value, "$salt");
  -        dbmopen(%DB, $file, 0664) || die "Error: $!\n";
  -        $hash .= ":$group" if $group ne "";
  -        $value .= ":$group" if $group ne "";
  -        $DB{$key} = $hash;
  -        dbmclose(%DB);
  -	print "User $key added with password $value, encrypted to $hash\n";
  -	exit;
  -}
  -
  -if ($command eq "delete") {
  -        dbmopen(%DB, $file, 0664) || die "Error: $!\n";
  -        delete($DB{$key});
  -        dbmclose(%DB);
  -	exit;
  -}
  -
  -if ($command eq "view") {
  -        dbmopen(%DB, $file, undef) || die "Error: $!\n";
  -        $return_status = 1;
  -        unless ($key) {
  -                while (($nkey,$val) = each %DB) {
  -                        print "$nkey = $val\n";
  -                }
  -        } else {
  -                $return_status = 0 if defined $DB{$key};
  -                print "$key = $DB{$key}\n";
  -        } 
  -        dbmclose(%DB);
  -	exit($return_status);
  +# usage: dbmmanage <DBMfile> <command> <key> <value>
  +
  +package dbmmanage;
  +#                               -ldb    -lndbm    -lgdbm
  +BEGIN { @AnyDBM_File::ISA = qw(DB_File NDBM_File GDBM_File) }
  +use strict;
  +use Fcntl;
  +use AnyDBM_File ();
  +
  +my($file,$command,$key,$crypted_pwd) = @ARGV;
  +
  +usage() unless $file and $command and defined &{$dbmc::{$command}};
  +
  +# if your osname is in $newstyle_salt, then use new style salt (starts with '_' and contains
  +# four bytes of iteration count and four bytes of salt).  Otherwise, just use
  +# the traditional two-byte salt.
  +# see the man page on your system to decide if you have a newer crypt() lib.
  +# I believe that 4.4BSD derived systems do (at least BSD/OS 2.0 does).
  +# The new style crypt() allows up to 20 characters of the password to be
  +# significant rather than only 8.
  +my $newstyle_salt = join '|', qw{bsdos}; #others?
  +
  +# remove extension if any
  +my $chop = join '|', qw{db.? pag dir};
  +$file =~ s/\.($chop)$//;
  +
  +my $is_update = $command eq "update";
  +my $Is_Win32  = $^O eq "MSWin32"; 
  +my %DB = ();
  +my @range = ();
  +my($mode, $flags) = $command =~ 
  +    /^(?:view|check)$/ ? (undef, O_RDONLY) : (0644, O_RDWR|O_CREAT);
  +
  +tie %DB, "AnyDBM_File", $file, $flags, $mode;
  +dbmc->$command();
  +untie %DB;
  +
  +sub usage {
  +    my $cmds = join "|", sort keys %dbmc::;
  +    die "usage: $0 filename [$cmds] [username]\n";
  +}
  +
  +my $x;
  +sub genseed {
  +    my $psf;
  +    for (qw(-xlwwa -le)) { 
  +	`ps $_ 2>/dev/null`;
  +	$psf = $_, last unless $?;
  +    }
  +    srand (time ^ $$ ^ unpack("%L*", `ps $psf | gzip -f`));
  +    @range = (qw(. /), '0'..'9','a'..'z','A'..'Z');
  +    $x = int scalar @range;
  +}
  +
  +sub randchar { 
  +    join '', map $range[rand $x], 1..shift||1;
  +}
  +
  +sub salt {
  +    my $newstyle = $^O =~ /(?:$newstyle_salt)/;
  +    genseed() unless @range; 
  +    return $newstyle ? 
  +	join '', "_", randchar, "a..", randchar(4) :
  +        randchar(2);
  +}
  +
  +sub getpass {
  +    my $prompt = shift || "Enter password:";
  +
  +    unless($Is_Win32) { 
  +	open STDIN, "/dev/tty" or warn "couldn't open /dev/tty $!\n";
  +	system "stty -echo;";
  +    }
  +
  +    my($c,$pwd);
  +    print STDERR $prompt;
  +    while ($c = getc(STDIN) and $c ne "\n" and $c ne "\r") {
  +	$pwd .= $c;
  +    }
  +
  +    system "stty echo" unless $Is_Win32;
  +    print STDERR "\n";
  +    die "Can't use empty password!\n" unless length $pwd;
  +    return $pwd;
   }
   
  -print "Command unrecognized - must be one of: view, add, adduser, delete.\n";
  +sub dbmc::update {
  +    die "Sorry, user `$key' doesn't exist!\n" unless $DB{$key};
  +    dbmc->adduser;
  +}
  +
  +sub dbmc::add {
  +    die "Can't use empty password!\n" unless $crypted_pwd;
  +    unless($is_update) {
  +	die "Sorry, user `$key' already exists!\n" if $DB{$key};
  +    }
  +    $DB{$key} = $crypted_pwd;
  +    my $action = $is_update ? "updated" : "added";
  +    print "User $key $action with password encrypted to $DB{$key}\n";
  +}
  +
  +sub dbmc::adduser {
  +    my $value = getpass "New password:";
  +    die "They don't match, sorry.\n" unless getpass("Re-type new password:") eq $value;
  +    $crypted_pwd = crypt $value, caller->salt;
  +    dbmc->add;
  +}
  +
  +sub dbmc::delete {
  +    die "Sorry, user `$key' doesn't exist!\n" unless $DB{$key};
  +    delete $DB{$key}, print "`$key' deleted\n";
  +}
  +
  +sub dbmc::view {
  +    print $key ? "$key:$DB{$key}\n" : map { "$_:$DB{$_}\n" if $DB{$_} } keys %DB;
  +}
  +
  +sub dbmc::check {
  +    die "Sorry, user `$key' doesn't exist!\n" unless $DB{$key};
  +    print crypt(getpass(), $DB{$key}) eq $DB{$key} ? "password ok\n" : "password mismatch\n";
  +}
  +
  +sub dbmc::import {
  +    while(defined($_ = <STDIN>) and chomp) {
  +	($key,$crypted_pwd) = split /:/, $_, 2;
  +	dbmc->add;
  +    }
  +}
   
  
  
  
  1.4       +139 -6    apache/support/dbmmanage.readme
  
  Index: dbmmanage.readme
  ===================================================================
  RCS file: /export/home/cvs/apache/support/dbmmanage.readme,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- dbmmanage.readme	1997/01/01 18:26:16	1.3
  +++ dbmmanage.readme	1997/08/02 22:42:25	1.4
  @@ -1,7 +1,140 @@
  +08/01/97 - functionality of dbmmanage and dbmmanage.new are merged,
  +along with adding some more goodies.
  +
  +There's a chance dbmmanage along with htpasswd, htdigest could be
  +replaced by something like the (prototype) script below, which allow
  +one to add passwords for:
  +
  +mod_auth
  +mod_auth_digest
  +mod_auth_dbm
  +mod_auth_db
  +mod_auth_msql
  +mod_auth_mysql
  +mod_auth_pg95
  +Apache::AuthenDBI (mod_perl)
  +
  +and possibly others provided you have the required Perl modules
  +installed available from CPAN.
  +
  +---8<---
  +
  +#!/opt/perl5/bin/perl
  +
  +BEGIN { @AnyDBM_File::ISA = qw(DB_File NDBM_File GDBM_File) }
  +use strict;
  +use HTTPD::UserAdmin ();
  +use AnyDBM_File ();
  +use File::Basename;
  +
  +my(%attr,@args);
  +my $script = basename $0;
  +
  +#names of old various programs, just symlinks now
  +$attr{DBTYPE} = {
  +    dbmmanage => "DBM",
  +    htpasswd  => "Text",
  +    htdigest  => "Text",
  +}->{$script};
  +
  +$attr{ENCRYPT} = "MD5" if $script eq "htdigest";
  +
  +do {
  +    if(s/^-//) {
  +	$attr{uc $_} = shift;
  +    }
  +    else {
  +	push @args, $_ if $_;
  +    }
  +} while $_ = shift;
  +
  +my($db,$command,$key,$crypted_pwd) = @args;
  +my $realm = $crypted_pwd if $attr{ENCRYPT} eq "MD5";
  +
  +usage() unless $db and $command and defined &{$dbmc::{$command}};
  +
  +if($attr{DBTYPE} eq "DBM") {
  +    #remove extension if any
  +    my $chop = join '|', qw{db.? pag dir};
  +    $db =~ s/\.($chop)$//;
  +}
  +
  +($attr{Mode}, $attr{Flags}) = $command =~ 
  +    /^(?:view|check)$/ ? (undef, "r") : (0644, "rwc");
  +
  +$attr{DB} = $db;
  +my $u = HTTPD::UserAdmin->new(DBMF => "AnyDBM", %attr);
  +dbmc->$command();
  +
  +sub usage {
  +    my $cmds = join "|", sort keys %dbmc::;
  +    die "usage: $0 filename [$cmds] [username] [crypted password|digest realm]\n";
  +}
  +
  +sub dbmc::update {
  +    print "User `$key' updated\n" if $u->update($key,getpass());
  +}
  +
  +sub dbmc::add {
  +    print "Entry $key added with value $crypted_pwd.\n" if $u->add($key, $crypted_pwd,
1);
  +}
  +
  +sub dbmc::adduser {
  +    my $value = getpass("New password:");
  +    die "They don't match, sorry.\n" unless getpass("Re-type new password:") eq $value;
  +    $value = "$key:$realm:$value" if $realm; #md5
  +    $u->add($key, $value);
  +    print "User $key added with encrypted to ", 
  +    $u->password($key), "\n";
  +}
  +
  +sub dbmc::delete {
  +    print "$key deleted\n" if $u->delete($key);
  +}
  +
  +sub dbmc::view {
  +    printf "$key:%s\n", $u->password($key) and return if $key; 
  +    for ($u->list) {
  +	print "$_:", $u->password($_), "\n";
  +    }
  +}
  +
  +sub dbmc::check {
  +    require HTTPD::Authen;
  +    print HTTPD::Authen->new($u)->basic->check($key, getpass()) ?
  +	"password ok\n" : "password mismatch\n";
  +}
  +
  +sub dbmc::import {
  +    while(defined($_ = <STDIN>) and chomp) {
  +	($key,$crypted_pwd) = split /:/, $_, 2;
  +	dbmc->add;
  +    }
  +}
  +
  +my $Is_Win32  = $^O eq "MSWin32"; 
  +sub getpass {
  +    my $prompt = shift || "Enter password:";
  +
  +    unless($Is_Win32) { 
  +	open STDIN, "/dev/tty" or warn "couldn't open /dev/tty $!\n";
  +	system "stty -echo;";
  +    }
  +
  +    my($c,$pwd);
  +    print STDERR $prompt;
  +    while ($c = getc(STDIN) and $c ne "\n" and $c ne "\r") {
  +	$pwd .= $c;
  +    }
  +
  +    system "stty echo" unless $Is_Win32;
  +    print STDERR "\n";
  +    die "Can't use empty password!\n" unless length $pwd;
  +    return $pwd;
  +}
  +
  +
  +
  +
  +
   
  -Two versions of the dbmmanage script are included with this release.
  -One is the old faithful version, which should continue to work if you've
  -been using it; the other is a newer cut, which can be easily modified to
  -support the newer extended crypt routines which are present on some
  -systems (including 4.4BSD derivatives); this newer version is, for the
  -nonce, experimental...
  
  
  

Mime
View raw message