Example 16.12: sigrand

#!/usr/bin/perl -w
# sigrand - supply random fortunes for .signature file

use strict;

# config section variables
use vars qw( $NG_IS_DIR $MKNOD $FULLNAME $FIFO $ART $NEWS $SIGS $SEMA
            $GLOBRAND $NAME );

# globals
use vars qw( $Home $Fortune_Path @Pwd );

################################################################
# begin configuration section 
# should really read from ~/.sigrandrc

gethome();

# for rec/humor/funny instead of rec.humor.funny
$NG_IS_DIR      = 1;    

$MKNOD          = "/bin/mknod";
$FULLNAME       = "$Home/.fullname";
$FIFO           = "$Home/.signature";
$ART            = "$Home/.article";
$NEWS           = "$Home/News";
$SIGS           = "$NEWS/SIGNATURES";
$SEMA           = "$Home/.sigrandpid";
$GLOBRAND       = 1/4;  # chance to use global sigs anyway

# $NAME should be (1) left undef to have program guess
# read address for signature maybe looking in ~/.fullname,
# (2) set to an exact address, or (3) set to empty string
# to be omitted entirely.

$NAME           = '';           # means no name used
## $NAME        = "me\@home.org\n";     

# end configuration section -- HOME and FORTUNE get autoconf'd
################################################################

setup();                # pull in inits
justme();               # make sure program not already running
fork && exit;           # background ourself and go away

open (SEMA, "> $SEMA")      or die "can't write $SEMA: $!";
print SEMA "$$\n";
close(SEMA)                    or die "can't close $SEMA: $!";

# now loop forever, writing a signature into the 
# fifo file.  if you don't have real fifos, change
# sleep time at bottom of loop to like 10 to update
# only every 10 seconds.
for (;;) {
    open (FIFO, "> $FIFO")  or die "can't write $FIFO: $!";
    my $sig = pick_quote();
    for ($sig) { 
        s/^((:?[^\n]*\n){4}).*$/$1/s;   # trunc to 4 lines
        s/^(.{1,80}).*? *$/$1/gm;       # trunc long lines
    }
    # print sig, with name if present, padded to four lines
    if ($NAME) { 
        print FIFO $NAME, "\n" x (3 - ($sig =~ tr/\n//)), $sig;
    } else {
        print FIFO $sig;
    }
    close FIFO;

    # Without a microsleep, the reading process doesn't finish before
    # the writer tries to open it again, which since the reader exists,
    # succeeds.  They end up with multiple signatures.  Sleep a tiny bit
    # between opens to give readers a chance to finish reading and close
    # our pipe so we can block when opening it the next time.

    select(undef, undef, undef, 0.2);   # sleep 1/5 second
}
die "XXX: NOT REACHED";         # you can't get here from anywhere

################################################################

# Ignore SIGPIPE in case someone opens us up and then closes the fifo
# without reading it; look in a .fullname file for their login name.
# Try to determine the fully qualified hostname.  Look our for silly
# ampersands in passwd entries.  Make sure we have signatures or fortunes.
# Build a fifo if we need to.

sub setup {
    $SIG{PIPE} = 'IGNORE';              

    unless (defined $NAME) {            # if $NAME undef in config
        if (-e $FULLNAME) {
            $NAME = `cat $FULLNAME`;
            die "$FULLNAME should contain only 1 line, aborting" 
                if $NAME =~ tr/\n// > 1;
        } else {
            my($user, $host);
            chop($host = `hostname`);
            ($host) = gethostbyname($host) unless $host =~ /\./;
            $user = $ENV{USER} || $ENV{LOGNAME} || $Pwd[0]
                or die "intruder alert";
            ($NAME = $Pwd[6]) =~ s/,.*//;
            $NAME =~ s/&/\u\L$user/g; # can't believe some folks still do this
            $NAME = "\t$NAME\t$user\@$host\n";
        } 
    }

    check_fortunes() if !-e $SIGS;

    unless (-p $FIFO) {         # -p checks whether it's a named pipe
        if (!-e _) {
             system("$MKNOD $FIFO p") && die "can't mknod $FIFO";
             warn "created $FIFO as a named pipe\n";
        } else {
             die "$0: won't overwrite file .signature\n";
        } 
    } else {
        warn "$0: using existing named pipe $FIFO\n";
    } 

    # get a good random number seed.  not needed if 5.004 or better.
    srand(time() ^ ($$ + ($$ << 15)));
}

# choose a random signature
sub pick_quote {
    my $sigfile = signame();
    if (!-e $sigfile) {
        return fortune();
    } 
    open (SIGS, "< $sigfile" ) or die "can't open $sigfile";
    local $/  = "%%\n";
    local $_;
    my $quip;
    rand($.) < 1 && ($quip = $_) while <SIGS>;
    close SIGS;
    chomp $quip;
    return $quip || "ENOSIG: This signature file is empty.\n";
} 

# See whether ~/.article contains a Newsgroups line.  if so, see the first
# group posted to and find out whether it has a dedicated set of fortunes.
# otherwise return the global one.  also, return the global one randomly
# now and then to spice up the sigs.
sub signame {
     (rand(1.0) > ($GLOBRAND) && open ART) || return $SIGS;   
     local $/  = '';
     local $_  = <ART>;
     my($ng)   = /Newsgroups:\s*([^,\s]*)/;
     $ng =~ s!\.!/!g if $NG_IS_DIR;     # if rn -/,  or SAVEDIR=%p/%c
     $ng = "$NEWS/$ng/SIGNATURES";
     return -f $ng ? $ng : $SIGS;
} 

# Call the fortune program with -s for short flag until
# we get a small enough fortune or ask too much.
sub fortune {
   local $_;
   my $tries = 0;
   do { 
       $_ = `$Fortune_Path -s`; 
   } until tr/\n// < 5 || $tries++ > 20;
   s/^/ /mg;
   $_ || " SIGRAND: deliver random signals to all processes.\n";
} 

# Make sure there's a fortune program.  Search 
# for its full path and set global to that.
sub check_fortunes {
    return if $Fortune_Path;    # already set
    for my $dir (split(/:/, $ENV{PATH}), '/usr/games') {
        return if -x ($Fortune_Path = "$dir/fortune");
    } 
    die "Need either $SIGS or a fortune program, bailing out";
} 

# figure out our directory
sub gethome {
    @Pwd = getpwuid($<);
    $Home = $ENV{HOME} || $ENV{LOGDIR} || $Pwd[7]
       or die "no home directory for user $<";
}

# "There can be only one."  --the Highlander
sub justme {
    if (open SEMA) {
        my $pid;
        chop($pid = <SEMA>);
        kill(0, $pid) and die "$0 already running (pid $pid), bailing out";
        close SEMA;
    } 
}