скрипт притерпел изменения.. фряха в домене в винде...
Код: Выделить всё
#!/usr/bin/perl
#
# printfax.pl 1.5.0, last changed 2000/03/22
#
###################################################################
#
# Copyright (C) 2000 Horst F <horstf(al)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(al)lotte.sax.de>
# added some modifications by
# Don Hayward <don(al)marinelab.sarasota.fl.us>
# Simon Hyde <shyde(al)poboxes.com>
# Helmut Lichtenberg <heli(al)tzv.fal.de>
# Ondrejicka Stefan <ondrej(al)idata.sk>
# Bryan Halvorson <bryan(al)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(al)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
# [2003/01/03 no version change]
# - corrected some English grammer in messages
####
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, $path);
### printfax.pl version string
$version = 'printfax.pl 1.5.0';
$path= '/var/spool/hylafax/sendq/';
### The default port we'll connect to RESPOND
$port = 5555;
### Use delay
$usedelay = 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/hylafax/log/printfax.log';
### Format of commandline
# $cmdlinefmt='mgetty';
$cmdlinefmt='hylafax';
### The faxspoolprogram
### for mgetty+sendfax:
# $faxspool = '/usr/bin/faxspool';
### for hylafax:
$faxspool = '/usr/local/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/local/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";
$msg_ignored = "ignored";
$msg_spooled = "spooled";
$msg_failed = "failed";
$msg_norespond = "You haven't started RESPOND.\nLaunch RESPOND and try again.\n";
$msg_strangeerr = "Some serverside error.\nTry again or contact an 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 = 0;
$nosendondebug = 1;
### 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 {
if ($messagebuffer && $smbclient && (!$debug || ($debug && ! -t STDERR))) {
open(SF,"|$smbclient -M $smbhost") || ($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($remote_ip, $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[0];
# 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");
}
### 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
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;
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);
# 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];
$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;
}
# 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 $faxfname $msg_to $faxdest " );
&smbmessage(($retval == 0) ? $msg_spooled : $msg_failed );
&smbmessage("\n");
}
}
### Done
if ($smbclient) {
&sendmessage();
}
close(ACCT);
exit 0;
) слушает свой порт только по ipv6, исесно клиент не может достучаться до него... Можно либо поправить 2 строчки в исходниках и пересобрать (будет только ipv4, что вряд ли кого-то сильно расстроит 
если кто докурил, напишите в личку интересует только отправка факса)