#!/usr/bin/perl
#
# printfax.pl 1.5.0, last changed 2000/03/22
#
###################################################################
#
# Copyright (C) 2000 Horst F <horstf@gmx.de>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###################################################################
#
# based on the script by
#   Heiko Schlittermann <heiko@lotte.sax.de>
# added some modifications by
#   Don Hayward <don@marinelab.sarasota.fl.us>
#   Simon Hyde <shyde@poboxes.com>
#   Helmut Lichtenberg <heli@tzv.fal.de>
#   Ondrejicka Stefan <ondrej@idata.sk>
#   Bryan Halvorson <bryan@pkgplus.com>
#
# 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@gmx.de>
#
# You can download the current version from
# http://www.boerde.de/~horstf/
#
# called from smb.conf:
#   print command = ( /usr/bin/printfax.pl %I %s %U %m; rm %s ) &
#
# History (changes since 1996/10/28/):
#   [1996/10/28]
#   - one script for all perl versions since 5.0 (or earlier?)
#     (joining the scripts for 5.002 and for earlier versions)
#   - replace of 'localhost' with call of hostname(), hope
#     this fixes the problem with SunOS
#   [1996/10/29 1.3.2]
#   - the use of hostname() doesn't solve the problem with SunOS,
#     the problem was gethostbyname, but now it works
#   - start version numbering, now it's 1.3.2
#   [1997/09/22 1.3.3]
#   - minor bug fix:
#     use "require/import" instead of "use Sys::Hostname" because
#     "use" includes a file at compile time and so it includes
#     Sys::Hostname every time, not only for perl version < 5.002
#   [1997/10/29 1.3.4]
#   - reading faxnumbers from file in user's home dir or everywhere
#   - added debug output
#   [1998/01/26 1.3.5]
#   - report errors with winpopup
#   - additional faxspool arguments in configuration section
#   - optional faxnumber preprocessing
#   [1999/02/19 1.4.0]
#   - allows '*' in faxnumber now
#   - missing smbclient don't breaks the use of multiple faxnumbers
#   - added support for Hylafax (untested)
#   [1999/07/01 1.4.1]
#   - avoid winpopup timeout (seen with WinNT)
#   [1999/12/05 1.4.2]
#   - bug fix: use '-d' switch for hylafax when no faxreceiver given
#   [2000/03/22 1.5.0]
#   - added support for Windows NT Terminal Server
#   - added workaround for the double connection problem
#   - added additional logging features
####

    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 ) {
      require Sys::Hostname;
      import Sys::Hostname;
    }

    my($last, $tmp);

###
### CONFIGURATION Section
###

    my($port, $usedelay, $defaultdelay, $acct, $faxspool, $smbclient,
       $logsmbhostname, $usesmbuser, $msg_to, $msg_ignored,
       $msg_spooled, $msg_failed, $debug, $allowfile, $filechar,
       $version, $nosendondebug, @faxspool_args, $msg_norespond,
       $msg_strangeerr, $intl_with, $unillegal, $unillegalnumbers,
       $termserver_ip, $ts_user, %respond_port, $minfaxsize,
       $cmdlinefmt, $remote_ip);

### printfax.pl version string
    $version = 'printfax.pl 1.5.0';

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

### Use delay
    $usedelay = 1;

    $remote_ip = '127.0.0.1';

### 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)
    $acct = '/var/spool/fax/log/printfax.log';

### Format of commandline
    $cmdlinefmt='mgetty';
#    $cmdlinefmt='hylafax';

### The faxspoolprogram
###   for mgetty+sendfax:
    $faxspool = '/usr/bin/faxspool';
###   for hylafax:
#    $faxspool = '/usr/bin/sendfax';

### Additional faxspool args (e.g. header, coverpage)
###   empty:
    @faxspool_args = qw();
###   for mgetty+sendfax with a special header:
#    @faxspool_args = qw( -h /usr/local/etc/mgetty+sendfax/faxheader.smb );
###   for hylafax with send email when job is done or requeued and use
###   a4 sized paper:
#    @faxspool_args = qw(-D -R -s a4);

### The smbclient program, sender is the faxsystem.
### Set to "" if you don't want to use smbclient
    $smbclient = '/usr/bin/smbclient -U FAX';

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

### Use smb hostname for logging, set to 0 for inet hostname
### (ip address will be logged in both cases)
    $logsmbhostname = 1;

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

### Preprocess faxnumbers, disable it if you use faxspool aliases
    # this replaces a leading '+', "" for no replace
    $intl_with = "";
    # delete all non numbers
    $unillegal = 0;
    # delete all non numbers, if faxnum contains only numbers and these characters
    # "" for no delete
    $unillegalnumbers = "()/-";

### messages for smbclient
### English:
    $msg_to = "to faxnumber";
    $msg_ignored = "ignored.";
    $msg_spooled = "spooled.";
    $msg_failed = "failed.";
    $msg_norespond = "RESPOND is not running\nLaunch RESPOND and try again.\n";
#   $msg_norespond = "You doesn't have started RESPOND\nLaunch RESPOND and try again\n";
    $msg_strangeerr = "Some serverside error\nTry again or contact administrator\n";
### German:
#    $msg_to = "an";
#    $msg_ignored = "ignoriert";
#    $msg_spooled = "gespoolt";
#    $msg_failed = "fehlgeschlagen";
#    $msg_norespond = "Respond laeuft nicht.\nBitte Respond starten und nochmal versuchen.\n";
#    $msg_strangeerr = "Fehler im Faxserver.\nBitte den Administrator benachrichtigen.\n";

### allow file for faxnumbers
    $allowfile = 1;
    $filechar = '@';

### set $debug to 1 for debug messages and $nosendondebug to 1 if
### you don't want to spool files on debug
### debug messages go to syslog (or stderr, if called from commandline)
    $debug = 1;
    $nosendondebug = 0;

### NT Terminal server and Win2000 sends out bogus print requests with
### short files. Treat requests with files less than this size as bogus.
    $minfaxsize = "100";

### extra config info for NT Terminal server.
### If you don't have an NT terminal server you can safely ignore this
### section. Currently only one terminal server is supported.

    # IP address of the terminal server, leave empty if you have none
#    $termserver_ip = "192.168.101.171";
    $termserver_ip = "";

    # Array of user-port assignments
    # If a request comes from the terminal server from one of the
    # users in the array the assigned port will be used instead of the
    # default port to connect to Respond
    %respond_port = (
# Samples
#      "me", "5556",
#      "myself", "5557",
#      "and_I", "5558"
    );

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

### Message buffer for smbclient (to avoid timeout)
my($messagebuffer);
$messagebuffer = '';

### Append a message to message buffer
sub smbmessage {
    $messagebuffer .= "@_";
}

### Send message buffer to windows client
my($smbhost);
sub sendmessage {
#    my($remote_ip) = @_;
    if ($messagebuffer && $smbclient && (!$debug || ($debug && ! -t STDERR))) {
        open(SF,"|$smbclient -M $smbhost -I $remote_ip") || ($smbclient = "");
        $last = select(SF); $| = 1; select($last);
        printf SF "$messagebuffer";
        close(SF);
    }
}

### Error functions

sub norespond {
    if ($smbclient) {
        &smbmessage("$msg_norespond");
        &sendmessage();
    }
    die "@_";
}

sub strangeerr {
    if ($smbclient) {
        &smbmessage("$msg_strangeerr");
        &sendmessage();
    }
    die "@_";
}

sub silenterr {
    die "@_";
}

### If called non interactivly ... use the logger to report errors
### in syslog

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


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

    if ($debug) {
      print STDERR "$version started with: ", join(" ",@ARGV), "\n";
    }

### COMMAND line processing
    my($faxfile, $smbuser, $faxfname);

    # 1.: The ip address (smb.conf: %I)
    $remote_ip = $ARGV[0];
    # 2.: The name of the faxfile with path (%s)
    $faxfile = $ARGV[1];
    # 3.: The samba session setup user (%U)
    # used for accounting and if RESPOND doesn't return the user name
    $smbuser = $ARGV[2];
    # 4.: The NetBIOS hostname (%m)
    $smbhost = $ARGV[3];

    # fm begin 05.02.2004: some more args:
    my($smbhome, $faxnumber);
    # 5.: The user's home (%H) - not used here
    $smbhome = $ARGV[4];
    # 6.: faxnumber - optional
    $faxnumber = $ARGV[5];
    # fm end

    # patch, allow per user header
    # detect the homedir of the user
    my $homedir;
    open(PASSWD,"< /etc/passwd");
    while (<PASSWD>) {
      my @elem = split /:/, $_;
      if (@elem[0] eq $smbuser) {
        $homedir = $elem[5];
      }
    }
    close(PASSWD);
    
    if (stat($homedir . "/faxheader")) {
      @faxspool_args = ("-h",$homedir . "/faxheader");
    }
    else {
      @faxspool_args = qw ( -h /etc/mgetty+sendfax/faxheader );
    }
    # end patch

    # Strip any domain from smbhost if required
    # (sometimes %m gets the full qualified internet name)
    $smbhost =~ s/^([^.]+).*$/$1/;

    # Strip path from filename 
    ($faxfname = $faxfile) =~ s|.*/||;

### Check on the file that samba handed us
    if (!(-f $faxfile)) {
      &strangeerr( "$0\[$$]: Fax file given on the command line doesn't exist.\n");
    }
    if (-z $faxfile) {
      &silenterr( "$0\[$$]: Fax file given on the command line is zero length.\n");
    }
    if ((-s $faxfile) < $minfaxsize) {
      &silenterr( "$0\[$$]: Fax file size is less than $minfaxsize.\n");
    }

    # fm begin 05.02.2004: check if $faxnumber is empty
    my($faxnum, $user, $faxreceiver, $fullname, $delayed);
    if ($faxnumber eq '') {
    # fm end

###  See if we're talking to a user on a terminal server
    if ($remote_ip eq $termserver_ip) {
       #  get the user name
       $ts_user = $smbuser;
       $ts_user =~ tr/A-Z/a-z/;

       # if the terminal server user has a different port number
       # assigned to the respond program, reset $port to match it.
       if ($respond_port{$ts_user}) {
         $port = $respond_port{$ts_user};
       }
       if ($debug) {
         print STDERR "User $ts_user is on a Terminal Server. Using port $port for respond.\n";
       }
    }


### Check config
    if (($cmdlinefmt ne 'hylafax') && ($cmdlinefmt ne 'mgetty')) {
      &strangeerr( "$0\[$$]: Illegal value for cmdlinefmt: $cmdlinefmt\n");
    }

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

# This does not work on some systems (gethostbyname doesn't work properly):
#      $ip_remote = (gethostbyname($remote_ip))[4] || 
#			&strangeerr("$0\[$$]: No such host: $remote_ip\n");
#      $remote = &Socket::sockaddr_in(AF_INET, $port, unpack('C4', $ip_remote));

# so we use this:
      $remote = &Socket::sockaddr_in(AF_INET, $port, split(/\./, $remote_ip));

      if ($debug) {
	print STDERR "trying to connect to $remote_ip as ",
		     join ('.', unpack('C4', $ip_local)), "\n";
      }

      socket(S, AF_INET, SOCK_STREAM, $proto) 
         || &strangeerr("$0\[$$]: Can't get socket: $!\n");

      bind(S, $local) || &strangeerr("$0\[$$]: Can't bind socket: $!\n");

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

# This seams to work:
      $ip_remote = inet_aton($remote_ip) || &strangeerr("$0\[$$]: No host: $remote_ip\n");
      $remote = sockaddr_in($port, $ip_remote);

# if not, try this:
#      $remote = sockaddr_in($port, pack('C4', split(/\./, $remote_ip)));

      if ($debug) {
          print STDERR "trying to connect to $remote_ip\n";
      }

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

    }
    connect(S, $remote) || &norespond("$0\[$$]: Can't connect to $remote_ip: $!\n");


    if ($debug) {
        print STDERR "connected\n";
    }

### Get the needed information
    # fm begin 05.02.2004: scope changed, see above
    # my($faxnum, $user, $faxreceiver, $fullname, $delayed);
    # fm end

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

    if ($debug) {
	print STDERR "got faxnumber: $faxnum\n";
	print STDERR "got receiver : $faxreceiver\n";
	print STDERR "got sender   : $user\n";
	print STDERR "got fullname : $fullname\n";
	print STDERR "got delay    : $delayed\n";
    }

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

    # Close the query connection
    close(S);

    # fm begin 05.02.2004: set faxnum, etc
    } else {
	$faxnum = $faxnumber;
	$faxreceiver = "";
	$user = "";
	$fullname = "";
	$delayed = "";
        # use default delay if respond's delay checkbox checked
        if ( $delayed eq 'delayed' ) { $delayed = $defaultdelay; }
    }
    # fm end

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

    # allways use smbuser (look in the configuration section)
    $user = $smbuser if $usesmbuser;

    # 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
    $fullname =~ s/^ *(.*) *$/\1/;
    if ( ! $fullname ) {
        $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];
    $yr += 1900;
    $mo++;      # month is 0 based.

    my($host, $faxdest);

    # Log smb or inet hostname (look in the configuration section)
    if ( $logsmbhostname ) {

        # Use the NetBIOS name for accounting:
        $host = "$smbhost($remote_ip)";

        # Uppercase looks more NetBIOS like :-)
        # uncomment if you don't want this
        $host =~ tr/a-z/A-Z/;

    } else {

        # Use the internet name for accounting:
        $host = (gethostbyaddr(pack('C4', split(/\./, $remote_ip)),AF_INET))[0];

        # Strip domains from name
        $host =~ s/^([^.]+).*$/$1/;
        $host = ($host) ? "$host($remote_ip)" : $remote_ip;

    }

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

    # Make it unbuffered
    $last = select(ACCT); $| = 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 $smbuser",
            $mo, $dy, $yr, $h, $m, $s;




        if ( $faxreceiver ) {
            print ACCT " to $faxreceiver";
            $faxdest = " " . $msg_to . " $faxreceiver"; 
        }
        print ACCT " cancelled\n";
	if ($smbclient) {
            &smbmessage("Fax $faxfname$faxdest $msg_ignored\n");
            &sendmessage();
	}
        close(ACCT);
	if ($debug) {
	    print STDERR "No faxnumbers given. Fax cancelled. Aborting\n";
	}
        exit 0;
    };

### Spool it

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

    # Arguments for faxspool call
    # --- Change this for other fax programs
    if ($cmdlinefmt eq 'hylafax') {
      @fixargs = ("-f",$user,"-r", $fullname);
    } elsif ($cmdlinefmt eq 'mgetty') {
      @fixargs = ("-q","-f","$user","-F","$fullname");
    }
    @fixargs = (@fixargs,@faxspool_args) if @faxspool_args;

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

    # do the "faxnumbers in a file" handling

    my(@newfaxnums, @numfiles1, @numfiles2, @files, $file, $fnum2);

    if ($allowfile) {

	# seperate between faxnumbers and filenames
	foreach $fnum (@faxnums) {
	    if (substr($fnum,0,1) eq $filechar ) {
		push(@numfiles1, $fnum);
	    } else {
		push(@newfaxnums, $fnum);
	    }
	}
	@faxnums = @newfaxnums;

	# now process the file(s), a file can contain other filenames
	while (scalar(@numfiles1)) {
	    foreach $fnum (@numfiles1) {
		$file = substr($fnum, 1);

		# Don't read a file twice (avoid endless loop)!
		next if scalar(grep($_ eq $file, @files));
		push(@files, $file);

		# Get user's home dir, if path is not absolute
		if (substr($file,0,1) ne '/') {
		    $file = (getpwnam($smbuser))[7] . "/$file";
		}

		# Read a file

		if ($debug) {
		    print STDERR "read file $file - ";
		}

		if (open(NUMBERS,"<$file")) {
		    while (<NUMBERS>) {

			# remove \r and \n
			tr/\r\n//d;

			# remove trailing blanks
			s/^ *(.*) *$/$1/;

			# ignore comments
			next if /^#/;

			# separate between faxnumbers and filenames
			foreach $fnum2 (split(/[ ,]+/)) {
			    if (substr($fnum2,0,1) eq $filechar) {
				push(@numfiles2, $fnum2);
			    } else {
				push(@faxnums, $fnum2);
			    }
			}
		    }
		    close(NUMBERS);

		    if ($debug) {
			print STDERR "ok\n",
		    }

		} elsif ($debug) {
		    print STDERR "failed\n";
		}
	    }

	    # recurse files
	    @numfiles1 = @numfiles2;
	    @numfiles2 = ();

	}
    }

    # preprocess faxnumbers
    if ( $intl_with || $unillegal || $unillegalnumbers) {
      for($tmp=0; $tmp<scalar(@faxnums); $tmp++) {
        $faxnums[$tmp] =~ s/^\+/$intl_with/ if $intl_with;
        if ( $unillegalnumbers ) {
          $_ = $faxnums[$tmp];
          # remove separator chars
          eval "tr[$unillegalnumbers][]d;";
          $faxnums[$tmp] = $_ if tr/*0-9// == length;
        } else {
          # remove all except digits and *
          $faxnums[$tmp] =~ tr/*0-9//cd if $unillegal;
        }
      }
    }
    # delete duplicate faxnumbers
    @newfaxnums = sort(@faxnums);
    @faxnums = ();
    $fnum2 = "";
    while ($fnum = shift(@newfaxnums)) {
	push(@faxnums, $fnum) if ($fnum ne $fnum2);
	$fnum2 = $fnum;
    }

    #
    # SK 04.01.2003
    #
    # ab 10 Empfaengern wird die Prioritaet auf 1 gesetzt.
    # Einzelfaxe haben per default prio 5 - werden also vorrangig
    # gegenueber Gruppenfaxe behandelt.
    #
    if ( @faxnums > 10 ) {
      @fixargs = (@fixargs,"-P","1");
    }


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

        # Build faxspool arguments from above arguments, number and file
        # --- Change this for other fax programs
	if( $cmdlinefmt eq 'hylafax' ) {
	    if ( $faxreceiver ) {
                # Add receivers name to faxspool arguments
                @faxargs = (@fixargs,"-d",$faxreceiver . '@'. $fnum,$faxfile);
            } else {
                @faxargs = (@fixargs,"-d",$fnum,$faxfile);
	    }
	} elsif ( $cmdlinefmt eq 'mgetty' ) {
            @faxargs = (@fixargs,$fnum,$faxfile);
            if ( $faxreceiver ) {
                # Add receivers name to faxspool arguments
                @faxargs = ("-D","$faxreceiver",@faxargs);
	    }
	} else {
            @faxargs = (@fixargs,$fnum,$faxfile);
        }

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

        # Call the fax spooler
	if ($debug) {
	    print STDERR "simulate " if ($nosendondebug);
	    print STDERR "call: $faxspool ", join(" ", @faxargs), "\n";
	}
	if (!$debug || ($debug && !$nosendondebug)) {
	    system($faxspool, @faxargs);
	}
	

        # Report the state to the logfile
        $retval = $?;
	if ($debug && !$nosendondebug) {
	    print STDERR "spooling ";
	    print STDERR ($retval == 0) ? "succeeded\n" : "failed\n";
	}
        print ACCT (($retval == 0) ? " spooled\n" : " failed\n");
	if ($smbclient) {
	    &smbmessage("Fax $msg_to  $faxdest " );
            &smbmessage(($retval == 0) ? $msg_spooled : $msg_failed );
            &smbmessage("\n");
	}
    }

### Done
    if ($smbclient) {
        &sendmessage();
    }
    close(ACCT);
    exit 0;
