scp@acl.lanl.gov (Stephen C. Pope) (03/17/90)
My earlier posted woes with perl 3.0 PL14 on the FPS Model500
are over. Patch #15 fixed the malloc problems I was having (passing
all tests, but issuing "bad free() ignored" messages sporadically when
running my own code. My other problem with makedbm turned out to be
due to FPS's /bin/passwd, which itself contacts yppasswd(!?!) (Coming
from the land of Sun, this was a real surprise), which meant that *two*
makedbms were racing each other to the death...
In any case, thanks for PL15, and I thought that others might be
interested in the remake of makedbm I did in the process. It appears to
be a satisfactory replacement for Sun's and FPS's makedbm. It adds
the -b option that Sun uses to place YP_INTERDOMAIN in the hosts
database which is missing on many BSD systems (like FPS's). Also,
it ignores any input file lines which are blank, start with a whitespace
character, or start with a `#'. Having been badly bitten recently
by an Ultrix VAX which couldn't grock a blank line hiding at the end of
/etc/services, this last option is a win (at least as long as nobody
wants blank lines or such to make it in to the database!).
Do look out for the call to /bin/hostname; I'm being a little
lazy there!
stephen pope
advanced computing lab, lanl
scp@acl.lanl.gov
makedbm.pl ------------------------------>8 ---------- snip, snip!
#!/usr/local/bin/perl
# This is a replacement for FPS's makedbm, which doesn't know
# how to do the YP_INTERDOMAIN entry for Sun YP<->DNS interaction.
# As a sidelight, it throws away comments and blank lines, just
# for safety's sake.
&Getopts('i:o:d:m:ub') || die 'unable to process arglist';
($infile = $ARGV[0]) || die 'no input file specified';
do dumpdbm($infile) if $opt_u;
($outfile = $ARGV[1]) || die 'no dbm file specified';
$tmpfile = "$outfile.tmp";
open(INFILE, $infile) || die "unable to open \"$infile\"";
die "\"$tmpfile\" already in use" if( -e $tmpfile );
dbmopen(ARY,$tmpfile,0600) || die "unable to open \"$tmpfile\"";
$time = ( $infile eq "-" ) ? time : (stat(INFILE))[9];
$ARY{'YP_LAST_MODIFIED'} = sprintf("%010d", $time);
if( $opt_m ) {
$master = $opt_m;
}
else {
chop($master = `hostname`);
}
die "unable to determine hostname" unless $master;
$ARY{'YP_MASTER_NAME'} = $master;
if( $opt_i ) { $ARY{'YP_INPUT_FILE'} = $opt_i; }
if( $opt_o ) { $ARY{'YP_OUTPUT_NAME'} = $opt_o; }
if( $opt_d ) { $ARY{'YP_DOMAIN_NAME'} = $opt_d; }
if( $opt_b ) { $ARY{'YP_INTERDOMAIN'} = ""; }
while( <INFILE> ) {
chop;
/^(\S*)\s+(.*)$/;
($key,$value) = ($1,$2);
$ARY{$key} = $value if($key && $key !~ /^#/ );
}
close INFILE;
dbmclose(ARY);
rename("$tmpfile.dir","$outfile.dir") && rename("$tmpfile.pag","$outfile.pag")
|| die "unable to rename \"$tmpfile\" to \"$outfile\"";
exit 0;
sub dumpdbm {
local($dbfile) = @_;
dbmopen(ARY,$dbfile,0600) || die "unable to open \"$dbfile\"";
print "$key $value\n" while(($key,$value) = each %ARY);
dbmclose(ARY);
exit 0;
}
sub Getopts {
local($argumentative) = @_;
local(@args,$_,$first,$rest,$errs);
local($[) = 0;
@args = split( / */, $argumentative );
while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
$pos = index($argumentative,$first);
if($pos >= $[) {
if($args[$pos+1] eq ':') {
shift @ARGV;
if($rest eq '') {
$rest = shift @ARGV;
}
eval "\$opt_$first = \$rest;";
}
else {
eval "\$opt_$first = 1";
if($rest eq '') {
shift @ARGV;
}
else {
$ARGV[0] = "-$rest";
}
}
}
else {
print STDERR "Unknown option: $first\n";
++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
}
else {
shift @ARGV;
}
}
}
$errs == 0;
}