[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