Script em perl(para quem sabe!!!)

["Diorgenes Mello" <dbmello@terra.com.br>]

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} =~ s@^\\\\$server\\print\$\\[^\\]+\\@@i;
		# flip the slashes
		#$driver->{$param} =~ s{\\}{/}g;
		# Basename
		$driver->{$param} =~ s@^.*\\@@;
		$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 =~ s@^\\\\$server\\print\$\\[^\\]+\\@@i;
	  #	  $file =~ s{\\}{/}g;
	  # Basename
	  $file =~ s@^.*\\@@;
	  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 =~ s@\\\\$server\\print\$\\@@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 ( !@arches ) {
	  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 =~ s@\\\\$server\\@@i;

  # investigate drivers
  my $cmd = "rpcclient -A /root/cred -d 0 -c \"getdriver \\\"$name\\\"
3\" $server";

  $name = $bitsref->{'name'} = $name;
  $name =~ s@\\\\$server\\@$me@i;
  $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'} = \@dfiles;
	}
  }

  if ( %drv ) {
	my %dbits = map { $_ => $drv{$_ }} keys %drv;
	push @arch, \%dbits;
	undef %drv;
  }

  $bitsref->{'drivers'} = \@arch;

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