Program: sigrand (Perl Cookbook, 2nd Edition)

## 16.23. Program: sigrand

The following program gives you random signatures by using named pipes. It expects the signatures file to have records in the format of the fortune program—that is, each possible multiline record is terminated with "`%%\n`". Here's an example:

>     Make is like Pascal: everybody likes it, so they go in and change it.
>                                                 --Dennis Ritchie
>     %%
>     I eschew embedded capital letters in names; to my prose-oriented eyes,
>     they are too awkward to read comfortably. They jangle like bad typography.
>                                                 --Rob Pike
>     %%
>     God made the integers; all else is the work of Man.
>                                                 --Kronecker
>     %%
>     I'd rather have :rofix than const.          --Dennis Ritchie
>     %%
>     If you want to program in C, program in C.  It's a nice language.
>     I use it occasionally...   :-)              --Larry Wall
>     %%
>     Twisted cleverness is my only skill as a programmer.
>                                                 --Elizabeth Zwicky
>     %%
>     Basically, avoid comments. If your code needs a comment to be understood,
>     it would be better to rewrite it so it's easier to understand.
>                                                 --Rob Pike
>     %%
>     Comments on data are usually much more helpful than on algorithms.
>                                                 --Rob Pike
>     %%
>     Programs that write programs are the happiest programs in the world.
>                                                 --Andrew Hume
>     %%

We check whether we're already running by using a file with our PID in it. If sending a signal number 0 indicates that PID still exists (or, rarely, that something else has reused it), we just exit. We also look at the current Usenet posting to decide whether to look for a per-newsgroup signature file. That way, you can have different signatures for each newsgroup you post to. For variety, a global signature file is still on occasion used even if a per-newsgroup file exists.

You can even use sigrand on systems without named pipes if you remove the code to create a named pipe and extend the sleep interval before file updates. Then .signature would just be a regular file. Another portability concern is that the program forks itself in the background, which is almost like becoming a daemon. If you have no `fork` call, just comment it out.

The full program is shown in Example 16-12.

#### 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;
>           }

>       }

Copyright © 2003 O'Reilly & Associates. All rights reserved.