#!/usr/bin/perl
#
# faxlprm version 1.0.1, last changed 9/11/1997
#
# (c) 1996 Horst F <horstf@weltentor.boerde.de>
#
# faxlprm removess a fax from the mgetty fax queue
#
# NOTE: I'm neither a perl nor network expert (as well
# English isn't my natural language too)

#####
# This script could be part of a samba/mgetty based fax solution
# for Win* clients. 
#
# It is intended to be used in conjunction with ``Winsock Respond Daemon''
# written by  "Horst F." <horstf@weltentor.boerde.de>
#
# You can download the current version from
# http://www.boerde.de/~horstf/
#
# called from smb.conf:
#   lprm command = /usr/bin/faxlprm %j %U
#
# ATTENTION: faxlpq reports only the sequence number as jobid,
# the pid will be ignored; faxlprm test also the username, hope
# nobody has two jobs with the same sequence number, otherwise
# faxlprm possibly removes the false faxjob
#
# NOTE: There is a bug in some samba releases. If you set a guest account
# in smb.conf in global and another in the service section the service 
# guest account entry will be ignored for lprm command. So you possibly run
# into permission problems.
#####

use strict;
no strict "refs";

my($user, $spooldir);

###
### Configuration section
###

### Username field
###   'mail' if you use guest account for fax service
###   'user' else
    $user = 'user';

### Spooldirectory
    $spooldir = "/var/spool/fax/outgoing";

### Secure path
    $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin' .
             ':/usr/local/sbin:/usr/sbin/:/sbin' .
             ':/usr/X11R6/bin';

###
### Nothing to configure below
###

my($dir, $file, @delfiles, $delete, $last);

-t STDERR || open(STDERR, "|logger -tfax") ||
   die "$0: Can't open logger: $!\n";

$last = select(STDERR); $| = 1; select($last);

(scalar(@ARGV) < 1) && die "$0: Argument missing\n";

$delete = sprintf("F%06d", $ARGV[0]);

# Open spooldir
opendir(SPOOL, $spooldir) || die "$0: Can't open $spooldir: $!\n";

# walk through the dirs
while ($dir = readdir(SPOOL)) {

  # Ignore some entries
  $dir =~ /^\./ && next;                 # Ignore hidden files
  -d "$spooldir/$dir" || next;           # Ignore other then dirs
  $dir =~ /^F\d\d\d\d\d\d\.?\d?/ || next; # Ignore false dir names

  substr($dir,0,7) eq $delete || next;           # Ignore false dirs

  # Rename the JOB file
  rename("$spooldir/$dir/JOB", "$spooldir/$dir/JOB.deleted")
    || rename("$spooldir/$dir/JOB.suspended", "$spooldir/$dir/JOB.deleted")
    || die "$0: Can't rename $dir/JOB: $!\n";

  # Check ownership of job if session setup user given
  if ("$ARGV[1]") {

    my($entry, $value, $name, %job);

    # Read the JOB file
    open(JOB,"$spooldir/$dir/JOB.deleted") || 
      die "$0: Can't open $dir/JOB.deleted: $!\n";
    undef %job;
    while (<JOB>) {
      tr/\r\n//d;
      ($entry, $value) = split(/ +/, $_, 2);
      if ( $entry ne 'Status' ) { $job{$entry} = $value; }
    }
    close(JOB);

    # Set the job owner
    $name = $job{$user};

    # Don't delete jobs the current session setup user not owns
    $name eq $ARGV[1] || exit;
  }

  # Get names of files to delete
  opendir(FAXDIR, "$spooldir/$dir") ||
    die "$0: Can't open $dir: $!\n";
  @delfiles = ();
  while ($file = readdir(FAXDIR)) {
    $file =~ /^\./ && next;
    $delfiles[scalar(@delfiles)] = "$spooldir/$dir/$file";
  }
  closedir(FAXDIR);

  # Delete them
  unlink(@delfiles) < ($#delfiles+1) &&
    die "$0: Can't remove all files from $dir: $!\n";

  # Remove the fax dir
  rmdir "$spooldir/$dir" || die "$0: Can't remove $dir: $!\n";

}
closedir(SPOOL);