Net::Spooler - A Perl extension for writing spooling daemons

  # Create a subclass of Net::Spooler
  use Net::Spooler;
  package MySpooler;
  @MySpooler::ISA = qw(Net::Spooler);

  # Inherit everything, except a single method:
  sub ProcessFile {
    my $self = shift; my $file = shift;

    # Try to process the file here
    ...

    # Raise an exception, if something went wrong:
    die "Failed: $!" unless Something();

    # Return to indicate sucess.
  }

  # Create and run the spooler
  package main;
  my $spooler = Net::Spooler->new(
      'spool-dir' => '/var/myspooler'
  );
  $spooler->Bind();

  $self->ReadFile($socket, $fh, $file, $control);

  $self->ControlFile($fh, $file, $control);

  my $ctrl = $self->ReadControlFile($file);

  Copyright (C) 1999		Jochen Wiedmann
                                Am Eisteich 9
			        72555 Metzingen
				Germany

                                E-Mail: joe@ispsoft.de

  All rights reserved.

  L<Net::Daemon(3)>

# -*- perl -*-
#
#   Net::Spooler - A Perl extension for writing spooling daemons
#
#   Copyright (C) 1999		Jochen Wiedmann
#				Am Eisteich 9
#				72555 Metzingen
#				Germany
#
#				E-Mail: joe@ispsoft.de
#
#   All rights reserved.
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
############################################################################

use strict;

use Net::Daemon ();
use File::Spec ();
use Symbol ();
use Data::Dumper ();
use Fcntl ();
use Safe ();
use Cwd ();

package Net::Spooler;

$Net::Spooler::VERSION = '0.02';
@Net::Spooler::ISA = qw(Net::Daemon);


sub Options ($) {
    my $opts = shift()->SUPER::Options();
    $opts->{'admin'} = { 'template' => 'admin=s',
			 'description' => '--admin=<email>         '
			 . "Admins email address"
		       };
    $opts->{'expiretime'} = { 'template' => 'expiretime=i',
			      'description' => '--expiretime=<secs>     '
			      . "Spool files expire after <secs> seconds"
			    };
    $opts->{'maxsize'} = { 'template' => 'maxsize=s',
			   'description' => '--maxsize=<bytes>       '
			   . "Refuse files larger than <bytes> bytes"
			 };
    $opts->{'processtimeout'} = { 'template' => 'processtimeout=i',
				  'description' => '--processtimeout=<secs> '
				  . "Stop processing files after <secs> seconds"
			 };
    $opts->{'spool-dir'} = { 'template' => 'spool-dir=s',
			     'description' => '--spool-dir=<dir>       '
			     . "Directory for creating spool files"
			   };
    $opts->{'spool-command'} = { 'template' => 'spool-command=s',
				 'description' => '--spool-command=<cmd>   '
				 . "Run <cmd> for processing spool files"
			       };
    $opts;
}

sub StatusOk {
}
sub StatusError {
}
sub StatusReject {
}

sub CommandFile {
    my($self, $file, $ctrl) = @_;

    my $command = $self->{'spool-command'};
    $command =~ s/\$\@file\$/$file/sg;
    $command =~ s/\$file\$/quotemeta($file)/seg;
    $command =~ s/\$\@control->([\-\w]+)\$/$ctrl>{$1}/seg;
    $command =~ s/\$control->([\-\w]+)\$/quotemeta($ctrl->{$1})/seg;
    $self->Debug("Processing $file: $command");
    my $ph = Symbol::gensym();
    open($ph, "$command 2>>errors.log |")
	or die "Failed to create pipe to command $command: $!";
    my $output;
    my $line;
    while (defined($line = <$ph>)) {
	$output .= $line;
	if ($line =~ /^\s*status\:\s*(.*?)\s*$/i) {
	    my $status = lc $1;
            if ($status eq 'ok') {
	        $self->StatusOk($file, $ctrl);
		return 1;
	    } elsif ($status eq 'error') {
		last;
	    } elsif ($status eq 'reject') {
		$self->StatusReject($file, $ctrl);
		while (defined($line = <$ph>)) {
		    $output .= $line;
		}
		close $ph;
		open($ph, ">>errors.log") and
		    (print $ph "\n" . localtime() . ", Reject while processing $file:\n$output");
		return 0;
	    }
        }
    }

    $self->StatusError($file, $ctrl);
    if (defined $line) {
	while (defined($line = <$ph>)) {
	    $output .= $line;
	}
    }
    close $ph;
    open($ph, ">>errors.log") and
	(print $ph "\n" . localtime() . ", Error while processing $file:\n$output");
    die "Failed to process $file: $output";
}

sub SequenceFile {
    my $self = shift;
    ".sequence";
}

sub Sequence {
    my $self = shift; my $file = shift;
    my $fh = Symbol::gensym();
    sysopen($fh, $file, Fcntl::O_RDWR()|Fcntl::O_CREAT(), 0644)
	or die "Failed to open sequence file $file for append: $!";
    flock($fh, Fcntl::LOCK_EX())
	or die "Failed to lock sequence file $file: $!";
    my $line = <$fh>;
    my $num = ((defined($line) && $line =~ /(\d+)/) ? $1 : 0) + 1;
    seek($fh, 0, 0)
	or die "Failed to beginning of sequence file $file: $!";
    my $sline = "$num\n";
    (print $fh $sline)
	or die "Failed to write to sequence file $file: $!";
    truncate($fh, length($sline))
	or die "Failed to truncate sequence file $file: $!";
    close($fh); # *No* unlock, this is done automatically as soon as
                # the destructur of $fh is called!
    $num;
}

sub DataFile {
    my $self = shift; my $seq = shift;
    "$seq.dat";
}

sub ControlFile {
    my $self = shift; my $seq = shift;
    "$seq.ctl";
}

sub IsControlFile {
    my $self = shift; my $file = shift;
    return ($file =~ s/\.ctl$/.dat/) ? $file : undef;
}

sub ReadFile {
    my($self, $socket, $fh, $file, $control) = @_;
    my $size = 0;
    my($buf, $len);

    while ($len = read($socket, $buf, 1024)) {
	$size += $len;
	die "Maximum size of $self->{'maxsize'} exceeded."
	    if ($self->{'maxsize'}  and $size > $self->{'maxsize'});
	(print $fh $buf)
	    or die "Failed to write into data file $file: $!";
    }
    die "Error while reading from client: $!" unless defined($len);
}

sub WriteControlFile {
    my($self, $fh, $file, $control) = @_;
    my $d = Data::Dumper->new([$control], ['control']);
    $d->Indent(1);
    (print $fh $d->Dump())
	or die "Failed to create control file $file: $!";
}

sub ReadControlFile {
    my $self = shift;  my $file = shift;  my $fh = shift;
    my $ctrl;
    if (ref($file) eq 'HASH') {
	$ctrl = $file;
    } else {
	unless ($fh) {
	    $fh = Symbol::gensym();
	    open($fh, "<$file") or die "Failed to open control file $file: $!";
	}
	local $/ = undef;
	my $contents = <$fh>;
	die "Failed to read control file $file: $!" unless defined($contents);
	my $cpt = Safe->new();
	$ctrl = $cpt->reval($contents);
	die $@ if $@;
	die "Expected hash ref being read from $file"
	    unless defined($ctrl) and ref($ctrl) eq 'HASH';
    }
    my $class = ref($self) . "::Control";
    my $clisa = $class . "::ISA";

    no strict 'refs';
    @$clisa = qw(Net::Spooler::Control) unless @$clisa;
    $class->new($ctrl);
}


############################################################################
#
#   Name:    new
#
#   Purpose: Constructor of the Net::Spooler class; overwrites
#	     Net::Daemon::new
#
#   Inputs:  $proto - Class name
#            $attr - Attributes hash ref
#            $options - Options array ref
#
#   Returns: New object, dies in case of trouble
#
############################################################################

sub new {
    my($proto, $attr, $options) = @_;
    $attr->{'loop-timeout'} = 300    unless exists $attr->{'loop-timeout'};
    $attr->{'loop-child'} = 1        unless exists $attr->{'loop-child'};
    my $self = $proto->SUPER::new($attr, $options);

    my $sdir = $self->{'spool-dir'}
        or die "Missing spool-dir attribute, use --spool-dir=<dir>";
    $sdir = $self->{'spool-dir'} = Cwd::abs_path($sdir);
    my $admin = $self->{'admin'}
        or die "Missing admin email address, use --admin=<admin>";

    # Test whether we have write permissions in the spool directory
    my $fh = Symbol::gensym();
    my $file = File::Spec->catfile($sdir, "WRITETEST");
    (open($fh, ">$file")  and  close($fh)  and  unlink $file)
	or die "Write test in $sdir failed, check --spool-dir and permissions";

    $self->{'expiretime'} = 432000 unless exists($self->{'expiretime'});
    $self->{'processtimeout'} = 0  unless exists($self->{'processtimeout'});
    $self->{'queuetime'} = 300     unless exists($self->{'queuetime'});
    $self->{'maxsize'} = 100000    unless exists($self->{'maxsize'});

    $self;
}


############################################################################
#
#   Name:    Loop
#
#   Purpose: In a loop, build the list of currently queued files and
#	     process them.
#
#   Inputs:  $self - Instance
#
#   Returns: Nothing; throws a Perl exception in case of errors.
#
############################################################################

sub Loop {
    my $self = shift;
    my $dh = Symbol::gensym();
    $self->Fatal("Failed to open directory $self->{'spool-dir'}: $!")
	unless opendir($dh, File::Spec->curdir());
    while (my $cfile = readdir($dh)) {
	my $dfile = $self->IsControlFile($cfile);
	next unless defined $dfile;
	my $ctrl = $self->ReadControlFile($cfile);
	$ctrl->Process($self);
    }
}

############################################################################
#
#   Name:    Run
#
#   Purpose: Accepts a single file from a client and stores it in the
#	     spool directory
#
#   Inputs:  $self - Instance
#
#   Returns: Nothing, dies in case of problems.
#
############################################################################

sub Run {
    my $self = shift;
    chdir $self->{'spool-dir'}
	or die "Failed to change directory to $self->{'spool-dir'}: $!";

    # Create a sequence number. This must not fail, because it may
    # impact the complete system. That's why we treat it special here.
    my($sfile, $seq);
    eval {
	$sfile = $self->SequenceFile();
	$seq = $self->Sequence($sfile);
    };
    if (!$seq) {
	$sfile ||= "the sequence file";
	my $msg = "Creating a sequence number from $sfile failed: $@";
	$self->Mail($msg
		    . "\n\nThis may prevent the system to work."
		    . "\nPlease take immediate action and restore the"
		    . "\nsequence file.");
	$self->Fatal($msg);
    }

    my $control = {};
    my $cfile = $self->ControlFile($seq);
    my $dfile = $self->DataFile($seq);
    my $time = time;
    $control->{'created'} = "$time (" . localtime($time) . ")";
    $control->{'control'} = $cfile;
    $control->{'data'} = $dfile;

    # Read the data file from the client
    my $dtfile = "$dfile.tmp";
    my $dtfh = Symbol::gensym();
    my $tmpfiles = $self->{'tmpfiles'} = { $dtfile => 1 };
    open($dtfh, ">$dtfile")
	or die "Failed to open data file $dtfile: $dtfh";
    $self->ReadFile($self->{'socket'}, $dtfh, $dtfile, $control);

    my $ctfile = "$cfile.tmp";
    my $ctfh = Symbol::gensym();
    $tmpfiles->{$ctfile} = 1;
    open($ctfh, ">$ctfile")
	or die "Failed to create temporary file $ctfile: $!";
    $self->WriteControlFile($ctfh, $ctfile, $control);

    rename $dtfile, $dfile
	or die "Failed to rename $dtfile to $dfile: $!";
    rename $ctfile, $cfile
	or die "Failed to rename $ctfile to $cfile: $!";
    my $ctrl = $self->ReadControlFile($control);
    undef $dtfh;
    undef $ctfh;
    delete $self->{'tmpfiles'};

    $ctrl->Process($self);
}


############################################################################
#
#   Name:    DESTROY
#
#   Purpose: Destructor of the Net::Spooler class; removes temporary files.
#
#   Inputs:  $self - Instance
#
#   Returns: Nothing
#
############################################################################

sub DESTROY {
    if (my $tf = delete shift()->{'tmpfiles'}) {
	unlink keys %$tf;
    }
}

sub Bind {
    my $self = shift;
    chdir $self->{'spool-dir'}
	or die "Failed to change directory to $self->{'spool-dir'}: $!";
    $self->SUPER::Bind(@_);
}

package Net::Spooler::Control;

sub new {
    my $proto = shift; my $hash = shift;
    my $self = $hash ? { %$hash } : {};
    bless($self, (ref($proto) || $proto));
}

sub Process {
    my $self = shift;  my $spooler = shift;

    # Lock the control file
    my $cfh = Symbol::gensym();
    my $cfile = $self->{'control'};
    my $dfile = $self->{'data'};
    $spooler->Debug("Processing file: data=$dfile, control=$cfile");
    open($cfh, "<$cfile") or die "Failed to open $cfile for input: $!";
    flock($cfh, Fcntl::LOCK_EX()) or die "Failed to lock $cfile: $!";

    # Set a timeout, if required
    my $result;
    eval {
	my $timeout = $spooler->{'processtimeout'};
	local $SIG{'ALRM'} = sub { die "Timeout" } if $timeout;
	alarm $timeout if $timeout;
	if ($spooler->{'spool-command'}) {
	    $result = $spooler->CommandFile($dfile, $self);
	} else {
	    $result = $spooler->ProcessFile($dfile);
	}
	alarm 0 if $timeout;
    };
    if ($@) {
	$spooler->Error("Failed to process $dfile: $@");
    } else {
	$spooler->Log('info', "Processed $dfile, result = %s\n",
			defined $result ? $result : "undef");
	unlink $cfile, $dfile;
    }
}

1;


__END__