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 [EMAIL PROTECTED]('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...
