[perl #28075] Perl-5.8.2 NDBM_File creates DB with Perl code inserts
supraexpress at globaleyes.net
supraexpress at globaleyes.net
Thu Apr 8 01:19:18 UTC 2004
Alternate subject:
Re: Apparent DB incompatibilities between FBSD Perl-5.8.2 and FBSD Inn-2.4.1
ports
Not being able to determine the cause of the aformentioned problem, I have
developed and tested the following attached scripts, primarily for use with
Perl-5.8.2 as I used its new SWITCH/CASE capability (which could be
"unrolled" for earlier Perl versions) in the 'password gen/read' scripts.
1) "gen.passwd.new" script to create a password file and insert user entries
for NDBM, DB1, DB2/3/4, and 'flatfile' (ala INN/CKPASSWD -f)
2) "read.passwd.new" script to read an NDBM, DB1, DB2/3/4, or 'flatfile'
database for a specific user entry (primarily for testing/verification)
3) "nnrpd_auth_DB1.pl" INN/readers.conf/perl_auth script for DB1 databases
4) "nnrpd_auth_DB234.pl" INN/readers.conf/perl_auth script for DB2/3/4
databases
5) "nnrpd_auth_NDBM.pl" INN/readers.conf/perl_auth script for NDBM databases
6) "nnrpd_auth_FLATFILE.pl" INN/readers.conf/perl_auth script for 'flat file'
databases ala CKPASSWD -f
The "nnrpd..." scripts should work with other versions of Perl, but I have
not yet tested them for that. Note that the current, live, INN testing was
done under Solaris9-x86/Perl-5.8.2/5.6.1, but the initial script development
and testing was done under FreeBSD-4.9/Perl-5.8.2. I will test again, later,
with a FreeBSD-4 INN host, but don't expect any problems.
-- Attached file included as plaintext by Ecartis --
-- File: gen.passwd.new
#!/usr/local/bin/perl
# print usage
if ($#ARGV != 7) {
print("\nUsage: gen.passwd.new -n <file name>\n");
print(" -t <storage type>\n");
print(" -u <userid>\n");
print(" -p <password>\n\n");
print("ALL parameters are required (on one line, of course)\n\n");
print(" <file name>: base filename for database or complete filename for flatfile,\n");
print(" quoted if necessary; case sensitive\n");
print(" <storage type>: n|ndbm, db|db1, db2|db3|db4, f|flatfile\n");
print(" <userid>,<password>: (case sensitive) plaintext strings, quoted if necessary\n\n");
print("Requirements: ndbm -> NDBM_File.pm\n");
print(" db1 -> DB_File.pm\n");
print(" db2-4 -> BerkeleyDB.pm; libdb2.x-libdb4.x\n");
print(" perl -> 5.8\n\n");
print("Berkeley databases (db1-4) are HASH formatted\n");
print("Flatfile corresponds to CKPASSWD flat file (-f) format\n\n");
exit 0;
}
require 5.008;
# process options
use Switch;
for ($I=0;$I<8;$I=$I+2) {
switch (@ARGV[$I]) {
case "-n" {$pwfilename = @ARGV[$I + 1]}
case "-t" {$filetype = lc(@ARGV[$I + 1])}
case "-u" {$userid = @ARGV[$I + 1]}
case "-p" {$userpw = @ARGV[$I + 1]}
else {print("INVALID PARAMETER: @ARGV[$I]\n"); exit 1}
}
}
my @alphabet = ('.', '/', 0..9, 'A'..'Z', 'a'..'z');
my $salt = join '', @alphabet[rand 64, rand 64];
my $cryptpasswd = crypt ($userpw, $salt);
# validate filetype
switch ($filetype) {
case /n|ndbm/ {NDBM()}
case /db2|db3|db4/ {DB234()}
case /db|db1/ {DB1()}
case /f|flatfile/ {FLATFILE()}
else {print("INVALID FILETYPE: $filetype\n")}
}
exit;
##############
sub DB234 {
if ($pwfilename =~ /.*\.db/) {
print("Invalid '.db' in '$pwfilename'\n"); return
}
$pwfilename=$pwfilename.".db";
print("DB234 pwfilename: $pwfilename, userid:$userid\n");
use BerkeleyDB;
use Fcntl;
my $db = new BerkeleyDB::Hash
-Filename => "$pwfilename",
-Flags => DB_CREATE
or die "cannot create '$pwfilename': $BerkeleyDB::Error\n";
$db->db_put("$userid", "$cryptpasswd");
$status=$db->db_close();
undef $db;
}
##############
sub NDBM {
if ($pwfilename =~ /.*\.db/) {
print("Invalid '.db' in '$pwfilename'\n"); return
}
print("NDBM pwfilename: $pwfilename.db, userid:$userid\n");
use NDBM_File;
use Fcntl;
my $db = NDBM_File::TIEHASH('NDBM_File', "$pwfilename", O_RDWR | O_CREAT, 0640)
or die "Cannot open '$pwfilename': $!\n";
$rc = NDBM_File::STORE($db, $userid, $cryptpasswd);
}
##############
sub FLATFILE {
print("FLATFILE pwfilename: $pwfilename, userid:$userid\n");
open(pwfile,">>$pwfilename") || die "Couldn't open '$pwfilename'\n";
print(pwfile "$userid:$cryptpasswd\n");
close(pwfile);
}
##############
sub DB1 {
if ($pwfilename =~ /.*\.db/) {
print("Invalid '.db' in '$pwfilename'\n"); return
}
$pwfilename=$pwfilename.".db";
print("DB1 pwfilename: $pwfilename, userid:$userid\n");
use DB_File;
use Fcntl;
tie (%db, 'DB_File', $pwfilename, O_RDWR | O_CREAT, 0640, $DB_HASH)
or die "Cannot open '$pwfilename': $!\n";
$db{$userid} = $cryptpasswd;
untie %db;
}
-- Attached file included as plaintext by Ecartis --
-- File: read.passwd.new
#!/usr/local/bin/perl
# print usage
if ($#ARGV != 7) {
print("\nUsage: read.passwd.new -n <file name>\n");
print(" -t <storage type>\n");
print(" -u <userid>\n");
print(" -p <password>\n\n");
print("ALL parameters are required (on one line, of course)\n\n");
print(" <file name>: base filename for database or complete filename for flatfile,\n");
print(" quoted if necessary; case sensitive\n");
print(" <storage type>: n|ndbm, db|db1, db2|db3|db4, f|flatfile\n");
print(" <userid>,<password>: (case sensitive) plaintext strings, quoted if necessary\n\n");
print("Requirements: ndbm -> NDBM_File.pm\n");
print(" db1 -> DB_File.pm\n");
print(" db2-4 -> BerkeleyDB.pm; libdb2.x-libdb4.x\n");
print(" perl -> 5.8\n\n");
print("Berkeley databases (db1-4) are HASH formatted\n");
print("Flatfile corresponds to CKPASSWD flat file (-f) format\n\n");
exit 0;
}
require 5.008;
# process options
use Switch;
for ($I=0;$I<8;$I=$I+2) {
switch (@ARGV[$I]) {
case "-n" {$pwfilename = @ARGV[$I + 1]}
case "-t" {$filetype = lc(@ARGV[$I + 1])}
case "-u" {$userid = @ARGV[$I + 1]}
case "-p" {$userpw = @ARGV[$I + 1]}
else {print("INVALID PARAMETER: @ARGV[$I]\n"); exit 1}
}
}
# validate filetype
switch ($filetype) {
case /n|ndbm/ {NDBM()}
case /db2|db3|db4/ {DB234()}
case /db|db1/ {DB1()}
case /f|flatfile/ {FLATFILE()}
else {print("INVALID FILETYPE: $filetype\n")}
}
exit;
##############
sub DB234 {
$pwfilename=$pwfilename.".db";
print("\nDB234 pwfilename: $pwfilename\n\n");
use BerkeleyDB;
my $db = new BerkeleyDB::Hash
-Filename => "$pwfilename"
or die "cannot open '$pwfilename': $BerkeleyDB::Error\n";
$db->db_get("$userid", $pwfpasswd);
if ($pwfpasswd eq "") {print("Userid:$userid - Not Found\n\n")}
else {
my $cryptpasswd = crypt($userpw,$pwfpasswd);
print("User:$userid, InputPW:$userpw\n");
print("pwfpasswd:'$pwfpasswd', cryptInputPW:'$cryptpasswd'\n");
if ("$pwfpasswd" eq "$cryptpasswd") {print("Passwords MATCH\n\n");}
else {print("Passwords do NOT match\n\n");}
}
$db->db_close();
undef $db;
}
##############
sub NDBM {
print("\nNDBM pwfilename: $pwfilename\n\n");
use NDBM_File;
use Fcntl;
tie (%db, 'NDBM_File', "$pwfilename", O_RDONLY, 0440)
or die "Cannot open '$pwfilename': $!\n";
my $pwfpasswd = $db{$userid};
if ("$pwfpasswd" eq "") {print("User:$userid - NOT FOUND\n\n")}
else {
my $cryptpasswd = crypt ($userpw, $pwfpasswd);
print("User:$userid, InputPW:$userpw\n");
print("pwfpasswd:'$pwfpasswd', cryptInputPW:'$cryptpasswd'\n");
if ("$pwfpasswd" eq "$cryptpasswd") {print("Passwords MATCH\n\n")}
else {print("Passwords do NOT match\n\n")}
}
untie %db;
}
##############
sub FLATFILE {
print("\nFLATFILE pwfilename: $pwfilename\n\n");
open(pwfile,"$pwfilename") || die "Couldn't open '$pwfilename'\n";
my $userfound = "no"; my $cryptpasswd = "";
while(<pwfile>) {
$dataline = $_; chomp $dataline;
($pwfuserid,$pwfpasswd) = split(":",$dataline);
$cryptpasswd = crypt($userpw, $pwfpasswd);
if ("$pwfuserid" eq "$userid") {$userfound = "yes";last}
}
if ("$userfound" eq "yes") {
print("User:$userid, InputPW:$userpw\n");
print("pwfpasswd:'$pwfpasswd', cryptInputPW:'$cryptpasswd'\n");
if ("$pwfpasswd" eq "$cryptpasswd") {print("Passwords MATCH\n\n")}
else {print("Passwords do NOT match\n\n")}
}
else {print("Userid:$userid - NOT found\n\n")}
close(pwfile);
}
##############
sub DB1 {
$pwfilename=$pwfilename.".db";
print("\nDB1 pwfilename: $pwfilename\n\n");
use DB_File;
use Fcntl;
tie (%db, 'DB_File', $pwfilename, O_RDONLY, 0440, $DB_HASH)
or die "Cannot open '$pwfilename': $!\n";
my $pwfpasswd = $db{$userid};
if ("$pwfpasswd" eq "") {print("User:$userid - NOT FOUND\n\n")}
else {
my $cryptpasswd = crypt ($userpw, $pwfpasswd);
print("User:$userid, InputPW:$userpw\n");
print("pwfpasswd:'$pwfpasswd', cryptInputPW:'$cryptpasswd'\n");
if ("$pwfpasswd" eq "$cryptpasswd") {print("Passwords MATCH\n\n")}
else {print("Passwords do NOT match\n\n")}
}
untie %db;
}
-- Attached file included as plaintext by Ecartis --
-- File: nnrpd_auth_DB1.pl
#! /usr/local/bin/perl
require '/usr/local/news/lib/innshellvars.pl';
##
## Sample code for the nnrpd Perl authentication hooks.
##
## Modified specifically for Berkeley DB1 hash databases - 7 April 2004
## Requires: DB_File.pm, Fcntl.pm
##
## This file is loaded when a perl_auth: parameter is reached in
## readers.conf. If it defines a sub named authenticate, that
## function will be called during processing of a perl_auth:
## parameter. Attributes about the connection are passed to the
## program in the %attributes global variable. It should return an
## array with two elements:
##
## 1) NNTP response code. Should be one of the codes from %authcodes
## below to not risk violating the protocol.
## 2) An error string to be passed to the client.
## Both elements are required. If there is a problem, nnrpd will die
## and syslog the exact error.
## The code below uses a user database based on CDB_File. It is
## provided here as an example of an authentication script.
## This file cannot be run as a standalone script, although it would be
## worthwhile to add some code so that it could so that one could test the
## results of various authentication and connection queries from the
## command line. The #! line at the top is just so that fixscript will
## work.
use strict;
use vars qw(%attributes %authcodes %users);
# These codes are a widely implemented de facto standard.
%authcodes = ('allowed' => 281, 'denied' => 502);
# This sub should perform any initialization work that the
# authentication stuff needs.
sub auth_init {
use DB_File;
use Fcntl;
tie (%users, 'DB_File', $inn::pathdb . '/users.db',O_RDONLY, 0440, $DB_HASH)
or warn "Could not open $inn::pathdb/users.db for users: $!\n";
}
# This function is called for authentication requests. For details on
# all the information passed to it, see ~news/doc/hook-perl.
sub authenticate {
return &checkuser();
}
# This function assumes that there's a database tied as %users that
# contains, keyed by users, a tab-separated list of the password (in
# crypt format), whether they can post, a wildmat matching what
# newsgroups they have access to, and the number of bytes per second
# they're allowed to use. This section of the code only accesses the
# username and password fields. See the file nnrpd_access.pl for
# access rights based on the other fields.
sub checkuser {
my $user = $attributes{'username'};
my $pass = $attributes{'password'};
return ($authcodes{denied}, "No username given.")
unless defined $user;
my $password = $users{$user};
return ($authcodes{denied}, "Incorrect password.")
if (crypt($pass, $password) ne $password);
return ($authcodes{allowed}, "");
}
-- Attached file included as plaintext by Ecartis --
-- File: nnrpd_auth_DB234.pl
#! /usr/local/bin/perl
require '/usr/local/news/lib/innshellvars.pl';
##
## Sample code for the nnrpd Perl authentication hooks.
##
## Modified specifically for Berkeley DB2-4 hash databases - 7 April 2004
## Requires: BerkeleyDB.pm
##
## This file is loaded when a perl_auth: parameter is reached in
## readers.conf. If it defines a sub named authenticate, that
## function will be called during processing of a perl_auth:
## parameter. Attributes about the connection are passed to the
## program in the %attributes global variable. It should return an
## array with two elements:
##
## 1) NNTP response code. Should be one of the codes from %authcodes
## below to not risk violating the protocol.
## 2) An error string to be passed to the client.
## Both elements are required. If there is a problem, nnrpd will die
## and syslog the exact error.
## The code below uses a user database based on CDB_File. It is
## provided here as an example of an authentication script.
## This file cannot be run as a standalone script, although it would be
## worthwhile to add some code so that it could so that one could test the
## results of various authentication and connection queries from the
## command line. The #! line at the top is just so that fixscript will
## work.
use strict;
use vars qw(%attributes %authcodes %users);
# These codes are a widely implemented de facto standard.
%authcodes = ('allowed' => 281, 'denied' => 502);
# This sub should perform any initialization work that the
# authentication stuff needs.
sub auth_init {
use BerkeleyDB;
tie (%users, 'BerkeleyDB::Hash', -Filename => $inn::pathdb . '/users.db')
or warn "Could not open $inn::pathdb/users.db for users: $!\n";
}
# This function is called for authentication requests. For details on
# all the information passed to it, see ~news/doc/hook-perl.
sub authenticate {
return &checkuser();
}
# This function assumes that there's a database tied as %users that
# contains, keyed by users, a tab-separated list of the password (in
# crypt format), whether they can post, a wildmat matching what
# newsgroups they have access to, and the number of bytes per second
# they're allowed to use. This section of the code only accesses the
# username and password fields. See the file nnrpd_access.pl for
# access rights based on the other fields.
sub checkuser {
my $user = $attributes{'username'};
my $pass = $attributes{'password'};
return ($authcodes{denied}, "No username given.")
unless defined $user;
my $password = $users{$user};
return ($authcodes{denied}, "Incorrect password.")
if (crypt($pass, $password) ne $password);
return ($authcodes{allowed}, "");
}
-- Attached file included as plaintext by Ecartis --
-- File: nnrpd_auth_FLATFILE.pl
#! /usr/local/bin/perl
require '/usr/local/news/lib/innshellvars.pl';
##
## Sample code for the nnrpd Perl authentication hooks.
##
## Modified specifically for a CKPASSWD (-f) "flat file" - 7 April 2004
## Requires: nothing extra
##
## This file is loaded when a perl_auth: parameter is reached in
## readers.conf. If it defines a sub named authenticate, that
## function will be called during processing of a perl_auth:
## parameter. Attributes about the connection are passed to the
## program in the %attributes global variable. It should return an
## array with two elements:
##
## 1) NNTP response code. Should be one of the codes from %authcodes
## below to not risk violating the protocol.
## 2) An error string to be passed to the client.
## Both elements are required. If there is a problem, nnrpd will die
## and syslog the exact error.
## The code below uses a user database based on CDB_File. It is
## provided here as an example of an authentication script.
## This file cannot be run as a standalone script, although it would be
## worthwhile to add some code so that it could so that one could test the
## results of various authentication and connection queries from the
## command line. The #! line at the top is just so that fixscript will
## work.
use strict;
use vars qw(%attributes %authcodes %users $userfound $pwfuserid $password $dataline);
# These codes are a widely implemented de facto standard.
%authcodes = ('allowed' => 281, 'denied' => 502);
# This sub should perform any initialization work that the
# authentication stuff needs.
sub auth_init {
open(users,$inn::pathdb . '/users.db')
or warn "Could not open $inn::pathdb/users.db for users: $!\n";
}
# This function is called for authentication requests. For details on
# all the information passed to it, see ~news/doc/hook-perl.
sub authenticate {
return &checkuser();
}
# This function assumes that there's a database tied as %users that
# contains, keyed by users, a tab-separated list of the password (in
# crypt format), whether they can post, a wildmat matching what
# newsgroups they have access to, and the number of bytes per second
# they're allowed to use. This section of the code only accesses the
# username and password fields. See the file nnrpd_access.pl for
# access rights based on the other fields.
sub checkuser {
my $user = $attributes{'username'};
my $pass = $attributes{'password'};
return ($authcodes{denied}, "No username given.")
unless defined $user;
$userfound = "no";
# flat file requires sequential search
while(<users>) {
$dataline = $_; chomp $dataline;
($pwfuserid,$password) = split(":",$dataline);
if ("$pwfuserid" eq "$user") {$userfound = "yes";last}
}
if ("$userfound" eq "no") {return ($authcodes{denied}, "Invalid userid.")}
return ($authcodes{denied}, "Incorrect password.")
if (crypt($pass, $password) ne $password);
return ($authcodes{allowed}, "");
}
-- Attached file included as plaintext by Ecartis --
-- File: nnrpd_auth_NDBM.pl
#! /usr/local/bin/perl
require '/usr/local/news/lib/innshellvars.pl';
##
## Sample code for the nnrpd Perl authentication hooks.
##
## Modified specifically for Berkeley NDBM databases - 7 April 2004
## Requires: NDBM_File.pm, Fcntl.pm
##
## This file is loaded when a perl_auth: parameter is reached in
## readers.conf. If it defines a sub named authenticate, that
## function will be called during processing of a perl_auth:
## parameter. Attributes about the connection are passed to the
## program in the %attributes global variable. It should return an
## array with two elements:
##
## 1) NNTP response code. Should be one of the codes from %authcodes
## below to not risk violating the protocol.
## 2) An error string to be passed to the client.
## Both elements are required. If there is a problem, nnrpd will die
## and syslog the exact error.
## The code below uses a user database based on CDB_File. It is
## provided here as an example of an authentication script.
## This file cannot be run as a standalone script, although it would be
## worthwhile to add some code so that it could so that one could test the
## results of various authentication and connection queries from the
## command line. The #! line at the top is just so that fixscript will
## work.
use strict;
use vars qw(%attributes %authcodes %users);
# These codes are a widely implemented de facto standard.
%authcodes = ('allowed' => 281, 'denied' => 502);
# This sub should perform any initialization work that the
# authentication stuff needs.
sub auth_init {
use NDBM_File;
use Fcntl;
# NDBM_File automatically appends ".db" to the filename
tie (%users, 'NDBM_File', $inn::pathdb . '/users', O_RDONLY, 0440)
or warn "Could not open $inn::pathdb/users.db for users: $!\n";
}
# This function is called for authentication requests. For details on
# all the information passed to it, see ~news/doc/hook-perl.
sub authenticate {
return &checkuser();
}
# This function assumes that there's a database tied as %users that
# contains, keyed by users, a tab-separated list of the password (in
# crypt format), whether they can post, a wildmat matching what
# newsgroups they have access to, and the number of bytes per second
# they're allowed to use. This section of the code only accesses the
# username and password fields. See the file nnrpd_access.pl for
# access rights based on the other fields.
sub checkuser {
my $user = $attributes{'username'};
my $pass = $attributes{'password'};
return ($authcodes{denied}, "No username given.")
unless defined $user;
my $password = $users{$user};
return ($authcodes{denied}, "Incorrect password.")
if (crypt($pass, $password) ne $password);
return ($authcodes{allowed}, "");
}
More information about the inn-workers
mailing list