[30017] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 1260 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Feb 6 16:14:16 2008

Date: Wed, 6 Feb 2008 13:14:09 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Wed, 6 Feb 2008     Volume: 11 Number: 1260

Today's topics:
        Is this used for spamming? <kcom@fusemail.com>
    Re: Is this used for spamming? <smallpond@juno.com>
    Re: lcd via NET::FTP <jimsgibson@gmail.com>
        moving binary data from one RDBMS to Other <a@a.com>
    Re: moving binary data from one RDBMS to Other <m@rtij.nl.invlalid>
    Re: moving binary data from one RDBMS to Other <a@a.com>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Wed, 06 Feb 2008 14:10:58 -0400
From: Caduceus <kcom@fusemail.com>
Subject: Is this used for spamming?
Message-Id: <8ptjq392m8rn3fneg0pqcav0ddsfk1s6ei@4ax.com>

Hi:

A lot of people tell me that this perl script is used for spamming.  I
was thinking of using it until I heard it was used for spamming.  If
it's used for spamming I don't want it.  Is this perl script used for
spamming?  TIA

==================================================
#!/usr/bin/perl -w
# Salter single-threaded email address salter

# (c) 2003-2007 Julian Haight,      http://www.julianhaight.com/
# All Rights Reserved under GPL: http://www.gnu.org/licenses/gpl.txt
# Current version available here:   http://www.julianhaight.com/salter

my($VERSION) = 'V1.6';

# Version history

# 26 Sep 2007 V1.6
# add wordlist support, for less-salty tasting random addresses

# 30 Jan 07 V1.5
# add dkim and domain keys signing

# 3/2/05 V1.4
# add more verbose status reporting

# 2/10/05 V1.3
# fixed bug related to unavailable smtp/regex

# 7/19/04 V1.2
# added stripsender feature
# fixed missing newline between header & body

# 3/26/04 V1.1
# cleaned up smtp sending code, added envonly mode, added version

# 3/12/04
# give each recipient their own, permanent random virtual sender
# move config to user-dir, not /etc.

# 9/29/03 - changed to use only lowercase-alpha, avoid spam filters
#  Also, added final response after quit (worked without for pine, but
not moz)

use strict; use Socket; use FileHandle; use Digest::MD5;

my($CONFIG) = ($ENV{HOME} . '/.salter'); 
my($MAPFN) = "$CONFIG/map.txt";
my($EOL) = "\015\012";
my($debug) = 0;
my($SMTPTO) = 10; # 10 second timeout
my($DKIMSELECT) = 'mail';
my(@wordlist);

my($SAMP) = ' 

# here is a sample config file:

listenport	2525
listenip	127.0.0.1
sendport	25
sendip		your_isps_mailserver.example.com
maxclient	5
# 1 for unsafe but fast!, 0 for slow & steady (not yet available)
buffermode      1
# 1 remaps only envelope, not header, good if you want to filter bad
bounces
envonly         0
# 1 strips sender field (for pine or whatever)
stripsender     1
# if missing, will use short (but good) internal list
wordlist        ~/.salter/wordlist.txt

#               From this address       To random @ this domain!
#               -----------------       ------------------------
remap	        you@example.com         salty.you.example.com
remap	        other@example.com       foo.example.com

# to set your identity per-recipient (email or part)
# -  use workplace address for work recipients
hardwire        workplace.example.com  you@workplace.example.com
# -  use mailing list subscription address when posting to list.
hardwire        list1@ml.example.com    listsubaddr@example.com

# if present for salted domain,
# salter will sign with dkim, using dkim selector "mail"
dkim.salty.you.example.com              ~/.salter/dkim_priv_key
dkim.foo.example.com                    ~/.salter/dkim_priv_key
dkim.example.com                        ~/.salter/dkim_priv_key

# end sample config!
';

my(%config, %remap, %map, %hardwire);
unless (-e $CONFIG) { mkdir($CONFIG); }
readConfig(); # read the config file into %config
readMap();
if (($config{wordlist}) && (-e $config{wordlist})) { 
    readWordList($config{wordlist}); 
} else {
    defaultWordList();
}
listenLoop(); # work 'til you die!
exit 0;

# listen for one connection at a time, and call the proxy for each
one.
# die if there are errors
sub listenLoop {
    my($cliaddr, $cliip, $cliport);
    socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || 
	die "Socket: $!";
    setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack('l', 1)) ||
	die "Setsockopt: $!";
    bind(SOCK, sockaddr_in($config{'listenport'}, 
			   inet_aton($config{'listenip'}))) ||
			   die "bind: $!";
    listen(SOCK, $config{'maxclient'}) || 
	die "listen: $!";
    while ($cliaddr = accept(CLI, SOCK)) {
#	print STDERR "got connection\n";
	($cliport, $cliip) = (sockaddr_in($cliaddr));
	CLI->autoflush(1);
	if ($_ = proxyIt(\*CLI)) {
	    print STDERR "<< 550 Proxy error: $_\n";
	}
    }
}

sub proxyIt {
   my($CLI) = @_;
   my($cmds, $head, $body, $cmd, $msgid);
   $body = '';
   $cmds = ''; 
   unless ($config{buffered}) {
       print $CLI "500 No safe delivery mode yet, sorry!$EOL";
       close($CLI);
       die "No safe mode yet, sorry!";
   }
   # read smtp
   print $CLI "220 localhost SMTP pretender: salter $VERSION $EOL";
   while ($cmd = <$CLI>) {
       $cmds .= $cmd || '';
       if (lc($cmd) eq "data$EOL") { last; }
       if (lc(substr($cmd, 0, 4)) eq 'ehlo') {
#	   print $CLI "451 EHLO is so, so complicated$EOL";
	   print $CLI "250 Buffering$EOL";
       } else {
	   print $CLI "250 Buffering$EOL";
       }
   }
   print $CLI "354 Ready for data$EOL";
   # read head
   while ($cmd = <$CLI>) {
       if ($cmd eq $EOL) { last; }
       if ((!$config{stripsender}) || ($cmd !~ m/^sender:/i)) {
	   $head .= $cmd;
       }
   }
   # read body
   while ($cmd = <$CLI>) {
       if ($cmd eq ".$EOL") { last; }
       $body .= $cmd;
   }
   while ($CLI && print $CLI "250 Buffering$EOL") {
       $cmd = <$CLI>;
       $cmds .= $cmd;
       if (lc($cmd) eq "quit$EOL") { last; }
   }
   print $CLI "221 Bye bye, hopefully it'll work!$EOL";
   close $CLI;
   if ($head =~ m/message-id: (\S+)/i) { $msgid = $1; }
   print "Accepted message $msgid\n";
   deliverAll($cmds, $head, $body);
   return undef();
}

sub deliverAll {
    my($cmds, $head, $body) = @_;
    my($recipmap, $message, $line, $remap, $recip, $sender, 
       $sremap, $sremap_dom, $cmd, $val, $S,
       @recips, $from);
    while ($cmds =~ m/([^:\n]*): ?\<?([^\>\n]*[^\s\>])?\>?/g) {
	$cmd = lc($1); $val = $2;
	if ($cmd eq 'mail from') {
	    $sender = $val;
	} elsif ($cmd eq 'rcpt to') {
	    $recip = $val;
	    $remap = getRecipMapping($recip);
	    push(@{$recipmap->{$remap}}, $recip);
	}
    }
    while ($_ = smtpOpen(*S)) {
	print STDERR "Cannot open smtp: $_, sleeping..\n";
	sleep(3);
    }
    foreach $remap (keys(%{$recipmap})) {
	$message = 'X-Mailer-Addon: Salter ' . $VERSION . 
	    ' http://www.julianhaight.com/salter' . $EOL . $head;
	$_ = $recipmap->{$remap};
	$sremap = $sender;
	(@recips) = (@$_);
	foreach $from (keys(%remap)) {
	    if ($remap =~ m/\@/) {
		unless ($config{envonly}) {
		    $message = replace($message, $from, $remap);
		}
		$sremap = replace($sremap, $from, $remap);
	    } else {
		unless ($config{envonly}) {
		    $message = replace($message, $from, 
				       $remap . '@' . $remap{$from});
		}
		$sremap = replace($sremap, $from, 
				  $remap . '@' . $remap{$from});
	    }
	}
	unless ($sremap) {
	    print STDERR "sender $sender not remapped\n";
	    $sremap = $sender;
	}
	$message .= $EOL . $body;

	if ($sremap =~ m/\@(.*)$/) {
	    $sremap_dom = $1;
	}
	if ( $config{ 'dkim.' . $sremap_dom } ) {
	    $message = signDkim($message, $sremap_dom);
	}
	if (($_ = smtpEnvelope(\*S, $sremap, @recips)) ||
	    ($_ = smtpData(\*S, $message))) {
	    print STDERR ("Failed to send: $_ saving in
$CONFIG/failed.txt");
	    open (SAVE, ">>$CONFIG/failed.txt");
	    print SAVE $message;
	    close(SAVE);
	} else {
	    print "Message delivered: $sremap -> @recips\n";
	}
    }
    smtpClose(\*S);
}

sub signDkim {
    require Mail::DKIM::Signer;
    
    my($dkim, $message, $domain, $sig, $sigtxt, $dktxt);
    ($message, $domain) = @_;
    if (!-e $config{'dkim.' . $domain}) {
	print STDERR "dkim private key for $domain is missing\n";
	return $message;
    }
    $dkim = new Mail::DKIM::Signer
	(Algorithm => 'rsa-sha1',
	 Domain => $domain,
	 Selector => $DKIMSELECT,
	 Method => 'relaxed',
	 KeyFile => $config{'dkim.' . $domain});
    $dkim -> PRINT($message);
    $dkim->finish_body();
    $sig = $dkim->signature();

    
    $sigtxt = $sig->as_string();

    $dktxt = $sigtxt;
#    $dktxt = $sigtxt = replace($sigtxt, ' ', $EOL . "\t");
    $dktxt = replace(replace($dktxt, 'c=relaxed', 'c=nofws'), 
		     'DKIM-Signature', 'DomainKey-Signature');
    $dktxt =~ s/bh=\S+\s*//;
    return $sigtxt . $EOL . $dktxt . $EOL . $message;
#    return $sigtxt . $EOL . $message;
}

sub signDomainKeys {
    require Mail::DomainKeys;
    my($dk, $key, $head, $body, $message, $domain);
    ($message, $domain) = @_;

    $dk = new Mail::DomainKeys::Message;
    if ($_ = index($message, $EOL . $EOL) >=0) {
	$head = substr($message, 0, $_);
	$body = substr($message, $_);
    } else {
	print STDERR "Cannot find head/body split for DomainKeys\n";
    }
    $dk->load(HeadString => $head,
	      BodyReference => $body);
    $key = load Mail::domainKeys::Key::Private
	(File => $config{'dkim.' . $domain});
    $dk->sign(Method=>'simple',
	      Selector=>$DKIMSELECT);
}

sub randWords {
    my($len) = @_; # no. of words to pick
    my($txt, $i);
    for ($i=0; $i < $len; $i++) {
	$txt .= $wordlist[int(rand() * $#wordlist)];
    }
    return $txt;
}

# no longer used
sub randSecret {
    my($len) = @_;
    my($char, $pass, $i);
    for ($i=0; $i < $len; $i++) {
	$char = int(rand() * 26);
	$char += 97;
	$pass .= pack('c', $char);
    }
    return $pass;
}

sub readConfig {
    my($line);
    my($fn) = "$CONFIG/salter.conf";
    unless (-e $fn) {
	print STDERR "Salter not configured.  Please create $fn.
Sample:
$SAMP
";
	exit 1;
    }
    open (CONFIG, $fn) || die "$fn $!";
    while ($line = <CONFIG>) {
	if ($line =~ m/^([^\#;\s]\S+)\s*(\S+)\s*(\S*).*$/) {
	    if ($1 eq 'remap') {
		$remap{$2} = $3;
	    } elsif ($1 eq 'hardwire') {
		$hardwire{$2} = $3;
	    } else {
		$config{$1} = $2;
	    }
	}
    }
    print STDERR "Listening on
$config{'listenip'}:$config{'listenport'} Outbound on
$config{'sendip'}:$config{'sendport'}\n";
}

sub getSenderMapping {
    my($addr) = lc(@_);
    return $remap{$addr}
}

sub getRecipMapping {
    my($addr) = lc($_[0]);
    my(@parts, $part);
    # exact match
    if ($part = $hardwire{$addr}) {
	return $part;
    }
    # domain match
    (@parts) = (getDomParts($addr));
    while (@parts) {
	if ($part = $hardwire{join('.', @parts)}) {
	    return $part;
	}
	pop(@parts);
    }
    # default randomizer
    return getMapping($addr);
}

sub getDomParts {
    my($addr) = @_;
    my($dom, @parts);
#    print "getDomParts $addr\n";
#    print hexDump($addr) . "\n";
    if ($addr =~ m/[^\@]*\@(.*)/) {
#    if ($addr =~ m/^\s*[^\@\s]+\@([^\@\s]+)\s*$/) {
	$dom = $1;
	(@parts) = (split(/\./, $dom));
    }
#    print STDERR "parts: @parts ($dom)\n";
    return (@parts);
}
    

sub getMapping {
    my($addr) = @_;
    my($hash) = Digest::MD5::md5_base64($addr);
    my($rand);
    unless ($rand = $map{$hash}) {
	$map{$hash} = ($rand = (randWords(2) . int(rand() * 99)));
	writeMap($hash, $rand);
    }
#    print "getMapping $addr = $rand\n";
    return ($rand);	
}

sub writeMap {
    open(MAP, ">>$MAPFN") || return 1;
    print MAP join(' ', @_) . "\n";
    close(MAP);
}

sub readMap {
    my($line);
    my($key, $val);
    unless (-e $MAPFN) {
	print STDERR "Starting hashed recip map in $MAPFN\n";
    } elsif (open (MAP, $MAPFN)) {
	while (($key, $val) = split(' ', <MAP>)) {
	    chop($map{$key} = $val);
	}
    } else {
	die "Error opening $MAPFN for read: $!";
    }
    close(MAP);
}

sub replace {
    my($text, $old, $new) = @_;
    my($loc, $len);
#    print "text: $text\n";
    if (index($new, $old) >= 0) { return $text; }
    $len = length($old);
    $loc = index($text, $old);
    while ($loc >= 0) {
	$text = substr($text, 0, $loc) . $new . substr($text, $loc +
$len);
	$loc = index($text, $old);
    }
#    print "replaced $old with $new in text: $text\n";
    return $text;
}

sub errlog {
    print STDERR "@_\n";
}

sub hexDump {
    my($string) = @_;
    my($size) = 15;
    my($char, $rval, $hex, $str, $asc);
    foreach $char (split('', $string)) {
	$asc = unpack('C', $char);
	if (($asc < 32) || ($asc > 176)) {
	    $char = '?';
	    $hex .= sprintf('%.2x<', $asc);
	} else {
	    $hex .= sprintf('%.2x ', $asc);
	}
	$str .= $char;
	if (length($str) >= $size) {
	    $rval .= $hex . $str . "\n";
	    $hex = ''; $str = '';
	}
    }
    if ($hex) {
	$hex .= (' ' x (($size*3) - length($hex)));
	$rval .= $hex . $str . "\n"
    }
    $rval = substr($rval, 0, length($rval)-1);
    return $rval;
}

sub readWordList {
    my($file) = @_;
    my($line);
    print "reading $file\n";
    open(IN, $file) || die "$file $!";
    (@wordlist) = ();
    while ($line = <IN>) {
	chomp($line);
	push(@wordlist, $line);
	print "$line\n";
    }
    close(IN);
}

sub defaultWordList {
    # http://ogden.basic-english.org/words.html (omiting operations)
    (@wordlist) = qw{
account act addition adjustment advertisement agreement air amount
amusement animal answer apparatus approval argument art attack attempt
attention attraction authority back balance base behavior belief birth
bit bite blood blow body brass bread breath brother building burn
burst business butter canvas care cause chalk chance change cloth coal
color comfort committee company comparison competition condition
connection control cook copper copy cork cotton cough country cover
crack credit crime crush cry current curve damage danger daughter day
death debt decision degree design desire destruction detail
development digestion direction discovery discussion disease disgust
distance distribution division doubt drink driving dust earth edge
education effect end error event example exchange existence expansion
experience expert fact fall family father fear feeling fiction field
fight fire flame flight flower fold food force form friend front fruit
glass gold government grain grass grip group growth guide harbor
harmony hate hearing heat help history hole hope hour humor ice idea
impulse increase industry ink insect instrument insurance interest
invention iron jelly join journey judge jump kick kiss knowledge land
language laugh law lead learning leather letter level lift light limit
linen liquid list look loss love machine man manager mark market mass
meal measure meat meeting memory metal middle milk mind mine minute
mist money month morning mother motion mountain move music name nation
need news night noise note number observation offer oil operation
opinion order organization ornament owner page pain paint paper part
paste payment peace person place plant play pleasure point poison
polish porter position powder power price print process produce profit
property prose protest pull punishment purpose push quality question
rain range rate ray reaction reading reason record regret relation
religion representative request respect rest reward rhythm rice river
road roll room rub rule run salt sand scale science sea seat secretary
selection self sense servant sex shade shake shame shock side sign
silk silver sister size sky sleep slip slope smash smell smile smoke
sneeze snow soap society son song sort sound soup space stage start
statement steam steel step stitch stone stop story stretch structure
substance sugar suggestion summer support surprise swim system talk
taste tax teaching tendency test theory thing thought thunder time tin
top touch trade transport trick trouble turn twist unit use value
verse vessel view voice walk war wash waste water wave wax way weather
week weight wind wine winter woman wood wool word work wound writing
year angle ant apple arch arm army baby bag ball band basin basket
bath bed bee bell berry bird blade board boat bone book boot bottle
box boy brain brake branch brick bridge brush bucket bulb button cake
camera card cart carriage cat chain cheese chest chin church circle
clock cloud coat collar comb cord cow cup curtain cushion dog door
drain drawer dress drop ear egg engine eye face farm feather finger
fish flag floor fly foot fork fowl frame garden girl glove goat gun
hair hammer hand hat head heart hook horn horse hospital house island
jewel kettle key knee knife knot leaf leg library line lip lock map
match monkey moon mouth muscle nail neck needle nerve net nose nut
office orange oven parcel pen pencil picture pig pin pipe plane plate
plough plow pocket pot potato prison pump rail rat receipt ring rod
roof root sail school scissors screw seed sheep shelf ship shirt shoe
skin skirt snake sock spade sponge spoon spring square stamp star
station stem stick stocking stomach store street sun table tail thread
throat thumb ticket toe tongue tooth town train tray tree trousers
umbrella wall watch wheel whip whistle window wing wire worm able acid
angry automatic beautiful black boiling bright broken brown cheap
chemical chief clean clear common complex conscious cut deep dependent
early elastic electric equal fat fertile first fixed flat free
frequent full general good great grey gray hanging happy hard healthy
high hollow important kind like living long male married material
medical military natural necessary new normal open parallel past
physical political poor possible present private probable quick quiet
ready red regular responsible right round same second separate serious
sharp smooth sticky stiff straight strong sudden sweet tall thick
tight tired true violent waiting warm wet wide wise yellow young awake
bad bent bitter blue certain cold complete cruel dark dead dear
delicate different dirty dry false feeble female foolish future green
ill last late left loose loud low mixed narrow old opposite public
rough sad safe secret short shut simple slow small soft solid special
strange thin white wrong
};
}

# (C) 2002, 2003 Julian Haight.  All rights reserved
# original sendmail 1.21 by Christian Mallwitz.
# Modified and 'modulized' by ivkovic@csi.com
# totally mangled by julian
# adapted for salter 3/13/04

sub smtpSend {
    my($message, $fromaddr, @recips) = @_;
    
    unless ($message) {
	errlog ("Refusing to send empty email $fromaddr -> @recips");
	return undef();
    }		    
    if ($debug) { errlog("trying smtpSend"); }
	
    # now, isn't that pretty?
    if (($_ = smtpOpen(\*S)) ||
	($_ = smtpEnvelope(\*S, $fromaddr, @recips)) ||
	($_ = smtpData(\*S, $message)) ||
	($_ = smtpClose(\*S))) {
	return ("smtpSend:" . $_);
    } else {
	return undef();
    }
}

sub smtpOpen {
    my($fh) = @_;
    my($k, $proto, $smtpaddr);
    ($smtpaddr) = (gethostbyname($config{sendip}))[4];
    
    my $save_w = $^W;
    local $/;
    $/ = "\015\012";
    
    $proto = (getprotobyname('tcp'))[2];
    unless (defined($smtpaddr)) {
	return ("smtpOpen: smtp host unknown:'" . $config{sendip} .
"'");
    }
    # open socket and start mail session
    if (!socket($fh, AF_INET, SOCK_STREAM, $proto)) {
        return ("smtpOpen: socket failed ( $! )");
    }

    # connect
    if (!connect($fh, pack('Sna4x8', AF_INET, $config{sendport},
$smtpaddr))) {
	if ($! eq 'Interrupted system call') {
	    return "smtpOpen: timeout after $SMTPTO seconds during
connect";
	} else {
	    return ("smtpOpen: connect to smtp server failed ($!)");
	}
    }
    my($oldfh) = select($fh); $| = 1; select($oldfh);
    if (($_ = smtpExchange($fh)) !~ m/^[23]/) {
        return ("smtpOpen: smtpsend connection error from smtp server
($_)");
    }
    if (($_ = smtpExchange($fh, "HELO Salter" . $VERSION)) !~
m/^[23]/) {
	return ("smtpOpen: smtpsend HELO error ($_)");
    }
    return undef();
}

sub smtpEnvelope {
    my($fh, $from, @recips) = @_;
    if (($_ = smtpFrom($fh, $from)) || ($_ = smtpTo($fh, @recips))) {
	return "smtpEnvelope ($from, @recips): $_";
    }
    return undef();
}

sub smtpFrom {
    my($fh, $from) = @_;
    if (($_ = smtpExchange($fh, "MAIL FROM: <$from>")) !~ m/^[23]/) {
        return ("smtpFrom: mail From $from: error ($_)");
    }
    return undef();
}

sub smtpTo {
    my($fh, @recips) = @_;
    my($to);
    unless (@recips) { return ("No recipient!") }
    foreach $to (@recips) {
	unless ($to) { 
	    errlog("Null recipient in smtpTo, skipping");
	    next; 
	}
	if (($_ = smtpExchange($fh, "RCPT TO: <$to>")) !~ m/^[23]/) {
	    return ("smtpTo rcpt to:$to ($_)");
        }
    }
    return undef();
}
    
sub smtpData {
    my($fh, $data) = @_;
    $data =~ s/^\./\.\./gm;     # handle . as first character
    if ($_ = smtpBeginData($fh)) { return $_; }
    smtpOutput($fh, $data);
    if ($debug) { errlog("Wrote " . length($data) . " bytes of data");
}
    return smtpEnd($fh);
}

sub smtpOutput {
    my($fh, $data) = @_;
    my($i, $c, $lc);

    for ($i = 0; $i < length($data); $i++) {
	$c = substr($data, $i, 1);
	if (($c eq "\012") && ($lc ne "\015")) {
	    print $fh "\015";
	}
	$lc = $c;
	print $fh $c;
    }
}

sub smtpBeginData {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "DATA")) !~ m/^[23]/) {
	return ("smtpBeginData: Cannot send data ($_)");
    }
    return undef();
}

sub smtpRset {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "RSET")) !~ m/^[23]/) {
	return ("smtpRset: Cannot rset smtp ($_)");
    }
    return undef();
}

sub smtpEnd {
    my($fh) = @_;
    if (($_ = smtpExchange($fh, "\015\012.")) !~ m/^[23]/) {
	return ("smtpEnd: message transmission failed: $_");
    }
    return undef();
}

sub smtpClose {
    my($fh) = @_;
    my($code) = smtpExchange($fh, "QUIT");
    close $fh;

    if ($code !~ m/^[23]/) {
	return ("smtpClose: cannot quit: $_");
    } else {
	return undef();
    }
}

sub smtpExchange {
    my($fh, $cmd) = @_;
    my($resp);
    if ($cmd) {
	print $fh ($cmd . "\015\012");
	if ($debug) { errlog(">> $cmd"); }
    }
    while (defined($resp = <$fh>) && ($resp !~ m/^(\d+)\s/)) {
	if ($debug) { errlog("<. $resp"); }
    }
    chomp($resp);
    if ($debug) { errlog("<< $resp"); }
    return $resp;
}


1;



------------------------------

Date: Wed, 6 Feb 2008 12:40:38 -0800 (PST)
From: smallpond <smallpond@juno.com>
Subject: Re: Is this used for spamming?
Message-Id: <73b0ff27-9f33-4ee5-bd95-e6d37d8fe665@i29g2000prf.googlegroups.com>

On Feb 6, 1:10 pm, Caduceus <k...@fusemail.com> wrote:
> Hi:
>
> A lot of people tell me that this perl script is used for spamming.  I
> was thinking of using it until I heard it was used for spamming.  If
> it's used for spamming I don't want it.  Is this perl script used for
> spamming?  TIA
>

You could have just posted a link to the website that the source
is from and read the description there:

http://www.julianhaight.com/useful.shtml

Julian Haight is the founder of SpamCop.

Your question is not a perl question, it is an ethics question.
Computers are used for spamming, so you should not use them either.
-- S


------------------------------

Date: Wed, 06 Feb 2008 09:25:54 -0800
From: Jim Gibson <jimsgibson@gmail.com>
Subject: Re: lcd via NET::FTP
Message-Id: <060220080925547662%jimsgibson@gmail.com>

In article
<fd9417a3-1c76-4ca9-b8d2-0ae59eb97125@q21g2000hsa.googlegroups.com>,
vikram <vikramganiga@gmail.com> wrote:

> Hi Everyone,
> 
> I want to view the local current directory using perl Net::FTP
> module..When i use lcd("local folder") its showing me the error.
> 
> Can't locate object method "lcd" via package "Net::FTP"

The documentation for Net::FTP doesn't mention an lcd method.

Use absolute path names instead.

-- 
Jim Gibson

 Posted Via Usenet.com Premium Usenet Newsgroup Services
----------------------------------------------------------
    ** SPEED ** RETENTION ** COMPLETION ** ANONYMITY **
----------------------------------------------------------        
                http://www.usenet.com


------------------------------

Date: 6 Feb 2008 08:50:43 -0800
From: Perl Lover<a@a.com>
Subject: moving binary data from one RDBMS to Other
Message-Id: <focoh302b4m@drn.newsguy.com>

Hi,

I am currently writing a perl dbi script to copy data from one rdbms to another.
One of the columns contain binary data. When I copy the data directly (reading
it from source, feeding it to target), it works fine. However when I save the
source data first in a file and then use that file to load it to the target it
messes up the binary data.

The source data is read via dbi cal fetchrow_array and the array is joined into
a string which is then print FILE to the file.
Am I doing something wrong here. Is there a better way to store the data without
using print, which does not corrupt the data.

thanks.



------------------------------

Date: Wed, 6 Feb 2008 20:39:39 +0100
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: moving binary data from one RDBMS to Other
Message-Id: <pan.2008.02.06.19.39.39@rtij.nl.invlalid>

On Wed, 06 Feb 2008 08:50:43 -0800, Perl Lover wrote:

> Hi,
> 
> I am currently writing a perl dbi script to copy data from one rdbms to
> another. One of the columns contain binary data. When I copy the data
> directly (reading it from source, feeding it to target), it works fine.
> However when I save the source data first in a file and then use that
> file to load it to the target it messes up the binary data.
> 
> The source data is read via dbi cal fetchrow_array and the array is
> joined into a string which is then print FILE to the file. Am I doing
> something wrong here. Is there a better way to store the data without
> using print, which does not corrupt the data.

I bet you are using windows and are seeing LF -> CRLF conversion. Try 
opening your files as binary files. See perldoc -f open and perldoc -f 
binmode.

HTH,
M4


------------------------------

Date: 6 Feb 2008 11:44:16 -0800
From: Perl Lover <a@a.com>
Subject: Re: moving binary data from one RDBMS to Other
Message-Id: <fod2mg0425@drn.newsguy.com>

In article <pan.2008.02.06.19.39.39@rtij.nl.invlalid>, Martijn Lievaart says...

>I bet you are using windows and are seeing LF -> CRLF conversion. Try 
>opening your files as binary files. See perldoc -f open and perldoc -f 
>binmode.

No. The files are created on Solaris and are used locally.



------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V11 Issue 1260
***************************************


home help back first fref pref prev next nref lref last post