[perl #28075] Perl-5.8.2 NDBM_File creates DB with Perl code inserts

[supraexpress at globaleyes.net]

Alternate subject:

Re: Apparent DB incompatibilities between FBSD Perl-5.8.2 and FBSD Inn-2.4.1
ports


With Perl-5.8.2, INN-2.4.1 CKPASSWD (on "my" FBSD-4.9 system) appears to no
longer be able to find a userid in an NDBM database file created by the
sample Perl script in the INN CKPASSWD MANual page. CKPASSWD is a C program.

I still have not figured out whether this is due to FBSD-4 methodoligies
provided for NDBM calls where there is no NDBM library present in the
system, but there is a libgdbm.so.3 present, or something else. All that I can
say for sure is: this problem did NOT occur with FBSD-4, Perl-5.6.1/5.00503,
and INN-2.4.1.

At this point, I am inclined to identify this as a FreeBSD(-4) + Perl-5.8.2 +
INN-2.4.1 "bug", and am developing other local scripts to create and read
various database file formats, including NDBM, which I will submit to INN.org
when completed.


For example ...

create "newspwfile.db" with one user,

./gen.passwd
Username: abcde
Password: abcde

cat gen.passwd [from CKPASSWD MANual page]
#!/usr/bin/perl
use NDBM_File;
use Fcntl;
tie (%db, 'NDBM_File', 'newspwfile', O_RDWR | O_CREAT, 0640)
    or die "Cannot open newspwfile: $!\n";
$| = 1;
print "Username: ";
my $user = <STDIN>;
chomp $user;
print "Password: ";
my $passwd = <STDIN>;
chomp $passwd;
my @alphabet = ('.', '/', 0..9, 'A'..'Z', 'a'..'z');
my $salt = join '', @alphabet[rand 64, rand 64];
$db{$user} = crypt ($passwd, $salt);
untie %db;
exit;



Use INN CKPASSWD to validate previous user:

/usr/local/news/bin/auth/passwd/ckpasswd -d newspwfile.db -u "abcde" -p "abcde"
ckpasswd: user abcde unknown


strings newspwfile.db
IXUSR S_IRWXU
                     S_IRGRP S_IWGRP S_IXGRP S_IRWXG
                     S_IROTH S_IWOTH S_IXOTH S_IRWXO
                     S_IREAD S_IWRITE S_IEXEC
                     S_ISREG S_ISDIR S_ISLNK S_ISSOCK
                     S_ISBLK S_ISCHR S_ISFIFO
                     S_ISWHT S_ISENFMT
                     S_IFMT S_IMODE
                  )],
sub S_IFMT  { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT()  }
sub S_IMODE { $_[0] & 07777 }
sub S_ISREG    { ( $_[0] & _S_IFMT() ) == S_IFREG()   }
sub S_ISDIR    { ( $_[0] & _S_IFMT() ) == S_IFDIR()   }
sub S_ISLNK    { ( $_[0] & _S_IFMT() ) == S_IFLNK()   }
sub S_ISSOCK   { ( $_[0] & _S_IFMT() ) == S_IFSOCK()  }
sub S_ISBLK    { ( $_[0] & _S_IFMT() ) == S_IFBLK()   }
sub S_ISCHR    { ( $_[0] & _S_IFMT() ) == S_IFCHR()   }
sub S_ISFIFO   { ( $_[0] & _S_IFMT() ) == S_IFIFO()   }
sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_IFWHT()   }
sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_IFENFMT() }
sub AUTOLOAD {
    (my $constname = $AUTOLOAD) =~ s/.*:://;
    die "&Fcntl::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) {
        my (undef,$file,$line) = caller;
        die "$error at $file line $line.\n";
    }
    *$AUTOLOAD = sub { $val };
    goto &$AUTOLOAD;
XSLoader::load 'Fcntl', $VERSION;
= shift;
    $pkg->TIEHASH(@_);
# Grandfather "new"
sub TIEHASH {
    my $pkg = shift;
    if (defined &{"${pkg}::new"}) {
        warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing");
        $pkg->new(@_);
    }
    else {
        croak "$pkg doesn't define a TIEHASH method";
    }
sub EXISTS {
    my $pkg = ref $_[0];
    croak "$pkg doesn't define an EXISTS method";
sub CLEAR {
    my $self = shift;
    my $key = $self->FIRSTKEY(@_);
    my @keys;
    while (defined $key) {
        push @keys, $key;
        $key = $self->NEXTKEY(@_, $key);
    }
    foreach $key (@keys) {
        $self->DELETE(@_, $key);
    }
# The Tie::StdHash package implements standard perl hash behaviour.
# It exists to act as a base class for classes which only wish to
# alter some parts of their behaviour.
package Tie::StdHash;
# @ISA = qw(Tie::Hash);         # would inherit new() only
sub TIEHASH  { bless {}, $_[0] }
sub STORE    { $_[0]->{$_[1]} = $_[2] }
sub FETCH    { $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY  { each %{$_[0]} }
sub EXISTS   { exists $_[0]->{$_[1]} }
sub DELETE   { delete $_[0]->{$_[1]} }
sub CLEAR    { %{$_[0]} = () }
package Tie::ExtraHash;
sub TIEHASH  { my $p = shift; bless [{}, @_], $p }
sub STORE    { $_[0][0]{$_[1]} = $_[2] }
sub FETCH    { $_[0][0]{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
sub NEXTKEY  { each %{$_[0][0]} }
sub EXISTS   { exists $_[0][0]->{$_[1]} }
sub DELETE   { delete $_[0][0]->{$_[1]} }
sub CLEAR    { %{$_[0][0]} = () }
JH9LWvYDgJ8FUabcde


Use a locally developed NDBM DB "reader" perl script:

./read.passwd.ndbm
Username: abcde
Password: abcde
pwfpasswd:JH9LWvYDgJ8FU
cryptpasswd:JH9LWvYDgJ8FU


cat read.passwd.ndbm
#!/usr/bin/perl
use NDBM_File;
use Fcntl;
tie (%db, 'NDBM_File', 'newspwfile', O_RDONLY, 0440)
    or die "Cannot open newspwfile: $!\n";
print "Username: ";
my $user = <STDIN>;
chomp $user;
print "Password: ";
my $passwd = <STDIN>;
chomp $passwd;
my $pwfpasswd = $db{$user};
print("pwfpasswd:$pwfpasswd\n");
my $cryptpasswd = crypt ($passwd, $pwfpasswd);
print("cryptpasswd:$cryptpasswd\n");
untie %db;
exit;