Estou com um script que "promete" buscar as impressoras de um servidor
samba ou windows e instala-las em outro, com os drivers e tudo mais,
mais ele está dando dois erros. e como eu não saco nada, mas nadinha
mesmo de PERL, estou pedindo a ajuda de vocês.
Oprimeiro erro é com uma impressora que tem a descrição muito grande...
o segundo ele acontece quando vai buscar os drivers no servidor...
segue abaixo o dito.
Diorgenes Mello
diorgenes.mello(at)ig.com.br
#!/usr/bin/perl -w
#
# Clone printers from one machine to another.
#
# Expects a credentials file in /root/cred; ignores the user and
# password parameters, but I never bothered cleaning them up.
#
#exemplo do arquivo /root/cred
#
# username=usuario
# password=senha_do_user
#
#
#
# Not really necessary since the getdriver call gets the full path anyway
# getdriverdir "Windows 4.0" | "Windows NT x86" | "Windows NT PowerPC"
| "Windows Alpha_AXP" | "Windows NT R4000"
use strict;
use IPC::Open3;
$| = 1;
my ( $user, $password, $server, $me ) = @ARGV;
die "usage: $0 user pass srv me" unless $user;
die "usage: $0 user pass srv me" unless $password;
die "usage: $0 user pass srv me" unless $server;
die "usage: $0 user pass srv me" unless $me; # my netbios name
# Samba doesn't really support the concept of ports, but it's kinda
# essential for add printer script to work correctly.
#
# Note, samba only works on a list of port names, so there's really no
# point in getting any further information.
print "Getting port list from $server...";
my @ports_enum = `rpcclient -A /root/cred -d 0 -c "enumports" $server`;
my @ports = map { ( $_ ) = m/^\s+Port Name:\s+\[(.*)\].*$/ } @ports_enum;
print "done.\n";
# Save the ports
open( PORTS, ">/etc/samba/ports" );
print PORTS join( "\n", @ports ) . "\n";
close( PORTS );
# enumprinters 2 currently fails due to a suspected bug in large RPC
handling
print "Getting printer list from $server...";
my @printers_enum = `rpcclient -A /root/cred -d 0 -c "enumprinters"
$server`;
print "done.\n";
print "Parsing printer list...\n";
my @printers;
my %printer;
for my $line ( @printers_enum ) {
next if $line =~ /^\s*$/;
chomp( $line );
my ( $field, $data ) = $line =~ m{^\s*([^:]+):\[([^]]*)\]$};
# XXX this isn't an obvious enough error if something does go wrong
# We should probably bail out earlier.
die "Failed on $line\n" if !defined( $field );
# flags is the first field of each printer, so use it as a 'flag' to
# save info.
if ( $field eq 'flags' ) {
if ( %printer ) {
print " " . $printer{'name'} . "\n";
my %bits = map { $_ => $printer{$_} } keys %printer;
my $bitsref = getprinterdetails( \%bits );
push @printers, $bitsref;
# reset hash
undef %printer;
}
}
$printer{ $field } = $data;
}
if ( %printer ) { # tail-end charlie
print " " . $printer{'name'} . "\n";
my %bits = map { $_ => $printer{$_} } keys %printer;
my $bitsref = getprinterdetails( \%bits );
push @printers, $bitsref;
}
print "Done with parsing.\n";
for my $printer ( @printers ) {
print "Cloning " . $printer->{'name'} ."\n";
for my $driver ( @{$printer->{'drivers'}}) {
my $cmd = "adddriver ";
my @cmd;
my @files; # list of files to copy from old server to new server
if ( !defined( $driver->{'architecture'})) {
print STDERR "Error, no architecture specified for this driver\n";
next;
}
$cmd .= '"' . $driver->{'architecture'} . '" ';
for my $param ( 'long printer name', 'driver file name', 'data file
name', 'config file name', 'help file name', 'language monitor name',
'default data type' ) {
if ( defined( $driver->{$param} ) && $driver->{$param}) {
# basename, essentially
push @files, $driver->{$param} if $param =~ /file name/;
# get rid of server, share, and arch
#$driver->{$param} =~ [EMAIL PROTECTED]@@i;
# flip the slashes
#$driver->{$param} =~ s{\\}{/}g;
# Basename
$driver->{$param} =~ [EMAIL PROTECTED]@@;
$driver->{$param} = '"' . $driver->{$param} . '"';
} else {
$driver->{$param} = "NULL";
}
# add to list
push @cmd, $driver->{$param};
}
$cmd .= join( ':', @cmd );
# Add the dependent files
$#cmd = -1;
for my $file ( @{$driver->{'dependent files'}}) {
push @files, $file;
# get rid of server, share, and arch
#$file =~ [EMAIL PROTECTED]@@i;
# $file =~ s{\\}{/}g;
# Basename
$file =~ [EMAIL PROTECTED]@@;
push @cmd, $file;
}
$cmd .= ":" . join( ',', @cmd );
# Now transfer the files across
print " fetching driver files from $server...";
my $cmd2 = "smbclient -A /root/cred //$server/print\\\$ -E -d 0 -c
'tarmode full' -Tc drivers.tar";
for my $f ( sort @files ) {
$f =~ [EMAIL PROTECTED]@@i;
$f = uc( $f ); # not sure it's necessary, but cleanliness etc.
$cmd2 .= " \"$f\"";
}
# Run the tar command. SMBTAR doesn't seem to complain a lot about
# errors, though.
`rm -f drivers.tar`;
my $junk = `$cmd2`;
chomp( $junk );
print "done.\n";
if ( $junk ) {
print " output: " . $junk . "\n";
}
# Now set up to drop the files on the new server. The files have
# to be uploaded to print$/arch; the adddriver command then moves
# them to the appropriate version directory. You can't put them in
# the version directory yourself as that will cause the adddriver
# command to fail.
# So basically here we're going to unpack the tar file, repack it,
# and then untar it using smbtar to put the files up on the server
# (and create the directory if necessary)
my $cwd;
print " unpacking driver files...";
chomp( $cwd = `pwd`);
`/bin/rm -rf /tmp/driver$$`;
mkdir( "/tmp/driver$$" );
chdir( "/tmp/driver$$" );
`tar xf $cwd/drivers.tar`;
print "done.\n";
# move files
opendir( DRV, "/tmp/driver$$" );
my @arches = grep !/^\.\.?$/, readdir( DRV );
closedir( DRV );
if ( [EMAIL PROTECTED] ) {
die "No files in /tmp/driver$$!\n";
}
# should only be the one, but let's be careful out there
for my $arch ( @arches ) {
opendir( DRV, "/tmp/driver$$/$arch" );
for my $vers ( grep !/^\.\.?$/, readdir( DRV )) {
opendir( VER, "/tmp/driver$$/$arch/$vers" );
for my $file ( grep !/^\.\.?$/, readdir( VER )) {
rename( "/tmp/driver$$/$arch/$vers/$file",
"/tmp/driver$$/$arch/$file" );
}
rmdir( "/tmp/driver$$/$arch/$vers" );
closedir( VER );
}
closedir( DRV );
}
print " repacking driver files...";
# retar
`tar cf $cwd/drivers.tar .`;
print "done.\n";
# and back to where we were
chdir( $cwd );
`rm -rf /tmp/driver$$`;
# push the drivers up to the server
$cmd2 = "smbclient -E -d 0 -A /root/cred //$me/print\\\$ -c 'tarmode
full' -Tx drivers.tar";
print " pushing drivers up to ${me}'s print\$ share...";
print "Tar Command: $cmd2\n";
$junk = `$cmd2`;
print "done.\n";
if ( $junk ) {
print " output: " . $junk . "\n";
}
# Add the driver
print " running adddriver command...";
$junk = `rpcclient -A /root/cred -d 0 -c '$cmd' $me`;
print "done.\n";
chomp( $junk ); chomp( $junk );
# hurgh
my $tmpfoo = $driver->{'long printer name'};
$driver->{'long printer name'} =~ s/^"//;
$driver->{'long printer name'} =~ s/"$//;
if ( $junk ne "Printer Driver " . $driver->{'long printer name'} . "
successfully installed.") {
print STDERR " failed, output: " . $junk . "\n";
print STDERR " expected >" . "Printer Driver " . $driver->{'long
printer name'} . " successfully installed." . "<\n";
exit(1);
}
$driver->{'long printer name'} = $tmpfoo;
# Now add the printer!
$cmd = qq(addprinter "$printer->{'name'}" "$printer->{'sharename'}"
$driver->{'long printer name'} "$printer->{'portname'}"\n);
print " running $cmd...";
$junk = `rpcclient -A /root/cred -d 0 -c '$cmd' $me`;
print "done.\n";
if ( $junk ) {
print " output: " . $junk . "\n";
}
unlink( "drivers.tar" );
}
# print "\n";
}
sub getprinterdetails {
my ( $bitsref ) = @_;
my @arch;
my %drv;
my $drvref = \%drv;
# take the server name out of the printer name
my $name = $bitsref->{'name'};
$name =~ [EMAIL PROTECTED]@@i;
# investigate drivers
my $cmd = "rpcclient -A /root/cred -d 0 -c \"getdriver \\\"$name\\\"
3\" $server";
$name = $bitsref->{'name'} = $name;
$name =~ [EMAIL PROTECTED]@[EMAIL PROTECTED];
$bitsref->{'name'} = $name;
my @enum = `$cmd`;
for my $line ( @enum ) {
next if $line =~ /^\s*$/;
chomp( $line );
$line =~ s/^\s*//;
if ( $line =~ /^\[.*\]/ ) {
if ( %drv ) {
my %dbits = map { $_ => $drv{$_ }} keys %drv;
push @arch, \%dbits;
undef %drv;
}
} elsif ( $line =~ /^Driver Name:\s*\[(.*)\]/ ) {
$drvref->{'long printer name'} = $1;
} elsif ( $line =~ /^Architecture: \[(.*)\]/ ) {
$drvref->{'architecture'} = $1;
} elsif ( $line =~ /^Driver Path:\s*\[(.*)\]/ ) {
$drvref->{'driver file name'} = $1;
} elsif ( $line =~ /^Datafile:\s*\[(.*)\]/ ) {
$drvref->{'data file name'} = $1;
} elsif ( $line =~ /^Configfile:\s*\[(.*)\]/ ) {
$drvref->{'config file name'} = $1;
} elsif ( $line =~ /^Helpfile:\s*\[(.*)\]/ ) {
$drvref->{'help file name'} = $1;
} elsif ( $line =~ /^Monitorname:\s*\[(.*)\]/ ) {
$drvref->{'language monitor name'} = $1;
} elsif ( $line =~ /^Defaultdatatype:\s*\[(.*)\]/ ) {
$drvref->{'default data type'} = $1;
} elsif ( $line =~ /^Dependentfiles:\s*\[(.*)\]/ ) {
my @dfiles;
@dfiles = @{$drvref->{'dependent files'}} if defined(
$drvref->{'dependent files'});
push @dfiles, $1;
$drvref->{'dependent files'} = [EMAIL PROTECTED];
}
}
if ( %drv ) {
my %dbits = map { $_ => $drv{$_ }} keys %drv;
push @arch, \%dbits;
undef %drv;
}
$bitsref->{'drivers'} = [EMAIL PROTECTED];
# Now get the other necessary details: share name and port name
$cmd = "rpcclient -A /root/cred -d 0 -c \"getprinter \\\"$name\\\"
2\" $server";
@enum = `$cmd`;
for my $line ( @enum ) {
next unless $line =~ /(sharename|portname):\[(.*)\]/i;
$bitsref->{$1} = $2;
}
$bitsref;
}
