#!/usr/bin/perl 
#
# fprintfax 1.1, last changed 12/11/1996
#
# (c) 1996 Horst F <horstf(al)infaut.et.uni-magdeburg.de>
#
# based on the script by
#   Heiko Schlittermann <heiko(al)lotte.sax.de>
# added some modification to run under perl5.002 by
#   Don Hayward (don(al)marinelab.sarasota.fl.us
#
# NOTE: I'm neither a perl nor network expert (as well
# English isn't my natural language too)

#####
# This script is intended to be used in conjunction with 
# ``Winsock Respond Daemon'' written by  
# "Horst F." <horstf(al)infaut.et.uni-magdeburg.de>
#
# You can download the current version from
# http://infaut.et.uni-magdeburg.de/~horstf/
#
# called from printcap:
#   :if=/var/spool/fax/fprintfax:
#
# History:
#   [11/21/1996]
#   - version 1.0
#   [12/11/1996]
#   - version 1.2
#   - double assignment to $tempfile removed
####

    require 5.0;      # Don't know if required include files exist
                      # in earlier versions
    use strict;
    no strict "refs";
    use Socket;

    # this is only required for perl versions below 5.002
    if ( $] < 5.002 ) { use Sys::Hostname; }

    my($last);

###
### CONFIGURATION Section
###

    my($port, $usedelay, $defaultdelay, $acct, $faxspool, $smbclient,
       $userealuser, $msg_to, $msg_ignored, $bufsize, $tempfile,
       $msg_spooled, $msg_failed, $debug, $guest, $default_acct);

### The port we'll connect to RESPOND
    $port = 5555;

### Use delay
    $usedelay = 0;

### Default delay for delayed faxes
    $defaultdelay = "18:00";

### The log file we'll write the accounting information to
### (It has to be writeable by the user samba is running as for faxes)
    $default_acct = "/var/spool/fax/fprintfax.log";
#    $default_acct = "/tmp/faxlog";

### tempfile for copying ($$ is the pid)
    $tempfile = "/var/spool/fax/fprintfax.$$";
#   $tempfile = "/tmp/fprintfax.$$";

### buffer size for copying
    $bufsize = 512;

### The faxspoolprogram (for mgetty+sendfax it's faxspool)
    $faxspool = "/usr/bin/faxspool";

### The smbclient program, sender is the faxsystem
    $smbclient = "/usr/bin/smbclient -U FAX";

### The secure path for binaries searched 
### (faxspool makes usage of the PATH environment!)
### (on SunOS you possibly have to add /usr/ucb)
    $ENV{PATH}  = '/usr/local/bin:/usr/bin:/bin' .
                  ':/usr/local/sbin:/usr/sbin:/sbin' .
                  ':/usr/X11R6/bin';

### Guest account
    $guest = 'printer';

### use realuser for returning mail, ignore what the user types in
### (realuser will be allways used for logging)
    $userealuser = 0;

### spool result messages via smbclient
    $msg_to = "an";
    $msg_ignored = "ignoriert";
    $msg_spooled = "angenommen";
    $msg_failed = "abgewiesen";

###
### NOTHING else to configure
###


### If called non interactivly use the logger to report errors
    -t STDERR
        || open(STDERR, "|logger -tfax")
        || die "$0: Can't open logger: $!\n";

### Make STDERR unbuffered
    $last = select(STDERR); $| = 1;
    select($last);


### COMMAND line processing
    my($arg, $value, $remote_host, $realuser);

    while ($arg = shift) {
      if (substr($arg,0,1) eq '-') {
        $value = substr($arg,2);
        $arg = substr($arg,1,2);
        if ($arg eq 'h') { $remote_host = shift; }

        # realuser is used for accounting and if RESPOND 
        # doesn't return the user name
        elsif ($arg eq 'n') { $realuser = shift; }
      } else { $acct = $arg; }
    }
    (! $remote_host) && die "$0: No host given\n";
    if (! $acct) { $acct = $default_acct; }
    if (! $realuser) { $realuser = $guest; }


### Establish the socket connection
    my($ip_remote, $remote, $proto);
    $proto = getprotobyname('tcp');

    # Since version 5.002 perl uses new ipc method
    if ( $] < 5.002 ) {
      # This is for perl versions below 5.002

      my($ip_local, $local);
      $ip_local = (gethostbyname(hostname()))[4];
      $local = &Socket::sockaddr_in(AF_INET, 0, unpack('C4', $ip_local));

      # gethostbyname doesn't work properly on some systems
      # (especially SunOS) till 5.001, if remote_host is a 
      # numerical netaddress
      if ($remote_host =~ /[\d]+\.[\d]+\.[\d]+\.[\d]+/) {

        # is numerical address
        $remote = &Socket::sockaddr_in(AF_INET, $port, split(/\./, $remote_host));

      } else {

        # is alphanumerical hostname
        $ip_remote = (gethostbyname($remote_host))[4] || 
                     die "$0: No host: $remote_host; $!\n";
        $remote = &Socket::sockaddr_in(AF_INET, $port, unpack('C4', $ip_remote));

      }

      socket(S, AF_INET, SOCK_STREAM, $proto) ||
	die "$0: Can't get socket: $!\n";
      bind(S, $local) || die "$0: Can't bind socket: $!\n";

    } else { 
      # This must be used since perl version 5.002

      $ip_remote = inet_aton($remote_host) || die "$0: No host: $remote_host\n";
      $remote = sockaddr_in($port, $ip_remote);

      socket(S, PF_INET, SOCK_STREAM, $proto) 
        || die "$0: Can't get socket: $!\n";

    }
    connect(S, $remote) || die "$0: Can't connect: $!\n";


### Get the needed information
    my($faxnum, $user, $faxreceiver, $fullname, $delayed);

    # Read FaxNr, User, Receivers name and Users fullname
    # as well as strip trailing \n or \r
    ($faxnum = <S>) =~ tr/\r\n//d;
    ($user = <S>) =~ tr/\r\n//d;
    ($faxreceiver = <S>) =~ tr/\r\n//d;
    ($fullname = <S>) =~ tr/\r\n//d;
    ($delayed = <S>) =~ tr/\r\n//d;

    # use default delay if respond's delay checkbox checked
    if ( $delayed eq 'delayed' ) { $delayed = $defaultdelay; }

    # Close the query connection
    close(S);

    # use samba user if no user is given
    $user = $realuser unless $user;

    # allways use realuser (look in the configuration section)
    $user = $realuser if $userealuser;

    # user needs to lowercased too
    $user =~ tr/A-Z/a-z/;

    my(@faxnums, $gcos);

    # split space or comma delimited faxnums (for more then one receiver)
    @faxnums = split(/[ ,]+/, $faxnum); 


    # Retrieve additional information about the user (here: the users
    # fullname) and the date

    # Extract fullname from /etc/passwd 
    # only if we didn't get it from respond
    if ( $fullname eq '' ) {
        $gcos = (getpwnam($user))[6];
        $fullname = (split(/,/, $gcos))[0];
    }
    $fullname = $user unless $fullname;

### OK, do accounting

    # What says the clock?
    my($s, $m, $h, $dy, $mo, $yr);
    ($s, $m, $h, $dy, $mo, $yr) = (localtime(time))[0..5];
    $mo++;      # month is 0 based.

    my($host, $faxdest);

    # Use the internet name for accounting:
    $host = (gethostbyaddr($ip_remote,AF_INET))[0];
    # Strip domains from name
    $host =~ s/^([^.]+).*$/$1/;

    # Use ip address if no name found
    if (! $host ) { $host = join('.',unpack('C4', $ip_remote)); }

    # Open the accounting file
    open(ACCT, ">>$acct") || die "$0: Can't open `$acct': $!\n";

    # Make it unbuffered
    $last = select(ACCT); $| = 1;
    select($last);

    # Establish the message connection, 
    # no die if open fails
    open(SF,"|$smbclient -M $remote_host");
    $last = select(SF); $| = 1; select($last);


    # If no faxnum is given it's assumed that cancelling the fax is ok.
    scalar(@faxnums) || do {
    printf ACCT "[%02d/%02d/%02d] %02d:%02d:%02d Fax from $host by $realuser",
            $mo, $dy, $yr, $h, $m, $s;
        if ( $faxreceiver ) {
            print ACCT " to $faxreceiver";
            $faxdest = " " . $msg_to . " $faxreceiver"; 
        }
        print ACCT " cancelled\n";
        print SF "Fax $faxdest ", $msg_ignored, "\n";
        close(SF);
        close(ACCT);
        exit 0;
    };

### Make tempfile

    my(@fixargs, @faxargs, $fnum, $retval, $buffer, $read);

    open(T,">$tempfile") || die "$0: Can't open $tempfile: $!\n";
    while (($read = sysread(STDIN,$buffer,$bufsize)) > 0) {
      syswrite(T,$buffer, $read);
    }
    close(T);

### Spool it

    # Arguments for faxspool call
    # --- Change this for other fax programs
    @fixargs = ("-q","-f","$user","-F","$fullname");

    # set delay if required
    if ( ($delayed ne '') && $usedelay ) {
      # Additional argument for faxspool call
      # --- Change this for other fax programs
      @fixargs = (@fixargs,"-t","$delayed");
    }

    # Spool it once for every number in $faxnum
    foreach $fnum (@faxnums) {
        printf ACCT "[%02d/%02d/%02d] %02d:%02d:%02d Fax from $host by $realuser ",
                $mo, $dy, $yr, $h, $m, $s;

        # Build faxspool arguments from above arguments, number and file
        # --- Change this for other fax programs
        @faxargs = (@fixargs,$fnum,$tempfile);

        if ( $faxreceiver ) {
            print ACCT "to $faxreceiver ($fnum)";
            $faxdest = "$faxreceiver ($fnum)";

            # Add receivers name to faxspool arguments
            # --- Change this for other fax programs
            @faxargs = ("-D","$faxreceiver",@faxargs);

        } else {
            print ACCT "to $fnum"; 
            $faxdest = "$fnum";
        }

        # Call the fax spooler
        # (for debugging comment this out and uncomment the print line)
        system($faxspool, @faxargs);
        print STDERR $faxspool, ' ', join(' ', @faxargs), "\n";

        # Report the state to the logfile
        # (next 4 lines should commented out for debugging)
        $retval = $?;
        print ACCT (($retval == 0) ? " spooled\n" : " failed");
        print SF "Fax $msg_to $faxdest ", 
           (($retval == 0) ? $msg_spooled : $msg_failed );
        print ACCT "\n";
        print SF "\n";
    }

### Done
    unlink $tempfile;
    close(SF);
    close(ACCT);
    exit 0;