|
Perl/FAQ/Интернет службы
Материал из Wiki.crossplatform.ru
Simple DNS Lookups
#-----------------------------
use Socket;
@addresses = gethostbyname($name) or die "Can't resolve $name: $!\n";
@addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses];
# @addresses is a list of IP addresses ("208.201.239.48", "208.201.239.49")
#-----------------------------
use Socket;
$address = inet_ntoa(inet_aton($name));
# $address is a single IP address "208.201.239.48"
#-----------------------------
use Socket;
$name = gethostbyaddr(inet_aton($address), AF_INET)
or die "Can't resolve $address: $!\n";
# $name is the hostname ("www.perl.com")
#-----------------------------
use Socket;
$packed_address = inet_aton("208.146.140.1");
$ascii_address = inet_ntoa($packed_address);
#-----------------------------
$packed = gethostbyname($hostname)
or die "Couldn't resolve address for $hostname: $!\n";
$address = inet_ntoa($packed);
print "I will use $address as the address for $hostname\n";
#-----------------------------
# $address is the IP address I'm checking, like "128.138.243.20"
use Socket;
$name = gethostbyaddr(inet_aton($address), AF_INET)
or die "Can't look up $address : $!\n";
@addr = gethostbyname($name)
or die "Can't look up $name : $!\n";
$found = grep { $address eq inet_ntoa($_) } @addr[4..$#addr];
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# mxhost - find mx exchangers for a host
use Net::DNS;
$host = shift;
$res = Net::DNS::Resolver->new();
@mx = mx($res, $host)
or die "Can't find MX records for $host (".$res->errorstring,")\n";
foreach $record (@mx) {
print $record->preference, " ", $record->exchange, "\n";
}
#-----------------------------
#% mxhost cnn.com
#10 mail.turner.com
#
#30 alfw2.turner.com
#-----------------------------
# download the following standalone program
#!/usr/bin/perl
# hostaddrs - canonize name and show addresses
use Socket;
use Net::hostent;
$name = shift;
if ($hent = gethostbyname($name)) {
$name = $hent->name; # in case different
$addr_ref = $hent->addr_list;
@addresses = map { inet_ntoa($_) } @$addr_ref;
}
print "$name => @addresses\n";
#-----------------------------
#% hostaddrs www.ora.com
#helio.ora.com => 204.148.40.9
#
#
#% hostaddrs www.whitehouse.gov
#www.whitehouse.gov => 198.137.240.91 198.137.240.92
#-----------------------------
Being an FTP Client
#-----------------------------
use Net::FTP;
$ftp = Net::FTP->new("ftp.host.com") or die "Can't connect: $@\n";
$ftp->login($username, $password) or die "Couldn't login\n";
$ftp->cwd($directory) or die "Couldn't change directory\n";
$ftp->get($filename) or die "Couldn't get $filename\n";
$ftp->put($filename) or die "Couldn't put $filename\n";
#-----------------------------
$ftp = Net::FTP->new("ftp.host.com",
Timeout => 30,
Debug => 1)
or die "Can't connect: $@\n";
#-----------------------------
$ftp->
login()
or die "Couldn't authenticate.\n";
$ftp->login($username)
or die "Still couldn't authenticate.\n";
$ftp->login($username, $password)
or die "Couldn't authenticate, even with explicit username
and password.\n";
$ftp->login($username, $password, $account)
or die "No dice. It hates me.\n";
#-----------------------------
$ftp->put($localfile, $remotefile)
or die "Can't send $localfile: $!\n";
#-----------------------------
$ftp->put(*STDIN, $remotefile)
or die "Can't send from STDIN: $!\n";
#-----------------------------
$ftp->get($remotefile, $localfile)
or die "Can't fetch $remotefile : $!\n";
#-----------------------------
$ftp->get($remotefile, *STDOUT)
or die "Can't fetch $remotefile: $!\n";
#-----------------------------
$ftp->cwd("/pub/perl/CPAN/images/g-rated");
print "I'm in the directory ", $ftp->pwd(), "\n";
#-----------------------------
$ftp->mkdir("/pub/gnat/perl", 1)
or die "Can't create /pub/gnat/perl recursively: $!\n";
#-----------------------------
@lines = $ftp->ls("/pub/gnat/perl")
or die "Can't get a list of files in /pub/gnat/perl: $!";
$ref_to_lines = $ftp->dir("/pub/perl/CPAN/src/latest.tar.gz")
or die "Can't check status of latest.tar.gz: $!\n";
#-----------------------------
$ftp->quit() or warn "Couldn't quit. Oh well.\n";
#-----------------------------
Sending Mail
#-----------------------------
use Mail::Mailer;
$mailer = Mail::Mailer->new("sendmail");
$mailer->open({ From => $from_address,
To => $to_address,
Subject => $subject,
})
or die "Can't open: $!\n";
print $mailer $body;
$mailer->
close();
#-----------------------------
open(SENDMAIL, "|/usr/lib/sendmail -oi -t -odq")
or die "Can't fork for sendmail: $!\n";
print SENDMAIL <<"EOF";
From: User Originating Mail <me\@host>
To: Final Destination <you\@otherhost>
Subject: A relevant subject line
Body of the message goes here, in as many lines as you like.
EOF
close(SENDMAIL) or warn "sendmail didn't close nicely";
#-----------------------------
$mailer = Mail::Mailer->new("sendmail");
#-----------------------------
$mailer = Mail::Mailer->new("mail", "/u/gnat/bin/funkymailer");
#-----------------------------
$mailer = Mail::Mailer->new("smtp", "mail.myisp.com");
#-----------------------------
eval {
$mailer = Mail::Mailer->new("bogus", "arguments");
# ...
};
if ($@) {
# the eval failed
print "Couldn't send mail: $@\n";
} else {
# the eval succeeded
print "The authorities have been notified.\n";
}
#-----------------------------
$mailer->open( 'From' => 'Nathan Torkington <gnat@frii.com>',
'To' => 'Tom Christiansen <tchrist@perl.com>',
'Subject' => 'The Perl Cookbook' );
#-----------------------------
print $mailer <<EO_SIG;
Are we ever going to finish this book?
My wife is threatening to leave me.
She says I love EMACS more than I love her.
Do you have a recipe that can help me?
Nat
EO_SIG
#-----------------------------
close($mailer) or die "can't close mailer: $!";
#-----------------------------
open(SENDMAIL, "|/usr/sbin/sendmail -oi -t -odq")
or die "Can't fork for sendmail: $!\n";
print SENDMAIL <<"EOF";
From: Tom Christiansen <tchrist\@perl.com>
To: Nathan Torkington <gnat\@frii.com>
Subject: Re: The Perl Cookbook
(1) We will never finish the book.
(2) No man who uses EMACS is deserving of love.
(3) I recommend coq au vi.
tom
EOF
close(SENDMAIL);
#-----------------------------
Reading and Posting Usenet News Messages
#-----------------------------
use Net::NNTP;
$server = Net::NNTP->new("news.host.dom")
or die "Can't connect to news server: $@\n";
($narticles, $first, $last, $name) = $server->group( "misc.test" )
or die "Can't select misc.test\n";
$headers = $server->head($first)
or die "Can't get headers from article $first in $name\n";
$bodytext = $server->body($first)
or die "Can't get body from article $first in $name\n";
$article = $server->article($first)
or die "Can't get article $first from $name\n";
$server->
postok()
or warn "Server didn't tell me I could post.\n";
$server->post( [ @lines ] )
or die "Can't post: $!\n";
#-----------------------------
<0401@jpl-devvax.JPL.NASA.GOV>
#-----------------------------
$server = Net::NNTP->new("news.mycompany.com")
or die "Couldn't connect to news.mycompany.com: $@\n";
#-----------------------------
$grouplist = $server->
list()
or die "Couldn't fetch group list\n";
foreach $group (keys %$grouplist) {
if ($grouplist->{$group}->[2] eq 'y') {
# I can post to $group
}
}
#-----------------------------
($narticles, $first, $last, $name) = $server->group("comp.lang.perl.misc")
or die "Can't select comp.lang.perl.misc\n";
#-----------------------------
@lines = $server->article($message_id)
or die "Can't fetch article $message_id: $!\n";
#-----------------------------
@group = $server->group("comp.lang.perl.misc")
or die "Can't select group comp.lang.perl.misc\n";
@lines = $server->head($group[1])
or die "Can't get headers from first article in comp.lang.perl.misc\n";
#-----------------------------
$server->post(@message)
or die "Can't post\n";
#-----------------------------
unless ($server->
postok()
) {
warn "You may not post.\n";
}
#-----------------------------
Reading Mail with POP3
#-----------------------------
$pop = Net::POP3->new($mail_server)
or die "Can't open connection to $mail_server : $!\n";
defined ($pop->login($username, $password))
or die "Can't authenticate: $!\n";
$messages = $pop->list
or die "Can't get list of undeleted messages: $!\n";
foreach $msgid (keys %$messages) {
$message = $pop->get($msgid);
unless (defined $message) {
warn "Couldn't fetch $msgid from server: $!\n";
next;
}
# $message is a reference to an array of lines
$pop->delete($msgid);
}
#-----------------------------
$pop = Net::POP3->new( "pop.myisp.com" )
or die "Can't connect to pop.myisp.com: $!\n";
#-----------------------------
$pop = Net::POP3->new( "pop.myisp.com",
Timeout => 30 )
or die "Can't connect to pop.myisp.com : $!\n";
#-----------------------------
defined ($pop->login("gnat", "S33kr1T Pa55w0rD"))
or die "Hey, my username and password didn't work!\n";
defined ($pop->login( "midget" )) # use Net::Netrc to find password
or die "Authentication failed.\n";
defined ($pop->
login())
# current username and Net::Netrc
or die "Authentication failed. Miserably.\n";
#-----------------------------
$pop->apop( $username, $password )
or die "Couldn't authenticate: $!\n";
#-----------------------------
%undeleted = $pop->
list();
foreach $msgnum (keys %undeleted) {
print "Message $msgnum is $undeleted{$msgnum} bytes long.\n";
}
#-----------------------------
print "Retrieving $msgnum : ";
$message = $pop->get($msgnum);
if ($message) {
# succeeded
print "\n";
print @$message; # print the message
} else {
# failed
print "failed ($!)\n";
}
#-----------------------------
Simulating Telnet from a Program
#-----------------------------
use Net::Telnet;
$t = Net::Telnet->new( Timeout => 10,
Prompt => '/%/',
Host => $hostname );
$t->login($username, $password);
@files = $t->cmd("ls");
$t->print("top");
(undef, $process_string) = $t->waitfor('/\d+ processes/');
$t->close;
#-----------------------------
/[\$%#>] $/
#-----------------------------
$telnet = Net::Telnet->new( Errmode => sub { main::log(@_) }, ... );
#-----------------------------
$telnet->login($username, $password)
or die "Login failed: @{[ $telnet->errmsg() ]}\n";
#-----------------------------
$telnet->waitfor('/--more--/')
#-----------------------------
$telnet->waitfor(String => 'greasy smoke', Timeout => 30)
#-----------------------------
Pinging a Machine
#-----------------------------
use Net::Ping;
$p = Net::Ping->new()
or die "Can't create new ping object: $!\n";
print "$host is alive" if $p->ping($host);
$p->close;
#-----------------------------
# use TCP if we're not root, ICMP if we are
$pong = Net::Ping->new( $> ? "tcp" : "icmp" );
(defined $pong)
or die "Couldn't create Net::Ping object: $!\n";
if ($pong->ping("kingkong.com")) {
print "The giant ape lives!\n";
} else {
print "All hail mighty Gamera, friend of children!\n";
}
#-----------------------------
Using Whois to Retrieve Information from the InterNIC
#-----------------------------
use Net::Whois;
$domain_obj = Net::Whois::Domain->new($domain_name)
or die "Couldn't get information on $domain_name: $!\n";
# call methods on $domain_obj to get name, tag, address, etc.
#-----------------------------
$d = Net::Whois::Domain->new( "perl.org" )
or die "Can't get information on perl.org\n";
#-----------------------------
print "The domain is called ", $d->domain, "\n";
print "Its tag is ", $d->tag, "\n";
#-----------------------------
print "Mail for ", $d->name, " should be sent to:\n";
print map { "\t$_\n" } $d->address;
print "\t", $d->country, "\n";
#-----------------------------
$contact_hash = $d->contacts;
if ($contact_hash) {
print "Contacts:\n";
foreach $type (sort keys %$contact_hash) {
print " $type:\n";
foreach $line (@{$contact_hash->{$type}}) {
print " $line\n";
}
}
} else {
print "No contact information.\n";
}
#-----------------------------
Program: expn and vrfy
#-----------------------------
#% cat > expn
#!/usr/bin/perl -w
#...
#^D
#% ln expn vrfy
#-----------------------------
#% expn gnat@frii.com
#Expanding gnat at frii.com (gnat@frii.com):
#
#calisto.frii.com Hello coprolith.frii.com [207.46.130.14],
#
# pleased to meet you
#
#<gnat@mail.frii.com>
#-----------------------------
#% expn gnat@frii.com
#Expanding gnat at mail.frii.net (gnat@frii.com):
#
#deimos.frii.com Hello coprolith.frii.com [207.46.130.14],
#
# pleased to meet you
#
#Nathan Torkington <gnat@deimos.frii.com>
#
#
#Expanding gnat at mx1.frii.net (gnat@frii.com):
#
#phobos.frii.com Hello coprolith.frii.com [207.46.130.14],
#
# pleased to meet you
#
#<gnat@mail.frii.com>
#
#
#E
#xpanding gnat at mx2.frii.net (gnat@frii.com):
#
#europa.frii.com Hello coprolith.frii.com [207.46.130.14],
#
# pleased to meet you
#
#<gnat@mail.frii.com>
#
#
#Expanding gnat at mx3.frii.net (gnat@frii.com):
#
#ns2.winterlan.com Hello coprolith.frii.com [207.46.130.14],
#
# pleased to meet you
#
#550 gnat... User unknown
#-----------------------------
# download the following standalone program
#!/usr/bin/perl -w
# expn -- convince smtp to divulge an alias expansion
use strict;
use IO::Socket;
use Sys::Hostname;
my $fetch_mx = 0;
# try loading the module, but don't blow up if missing
eval {
require Net::DNS;
Net::DNS->import('mx');
$fetch_mx = 1;
};
my $selfname = hostname();
die "usage: $0 address\@host ...\n" unless @ARGV;
# Find out whether called as "vrfy" or "expn".
my $VERB = ($0 =~ /ve?ri?fy$/i) ? 'VRFY' : 'EXPN';
my $multi = @ARGV > 1;
my $remote;
# Iterate over addresses give on command line.
foreach my $combo (@ARGV) {
my ($name, $host) = split(/\@/, $combo);
my @hosts;
$host ||= 'localhost';
@hosts = map { $_->exchange } mx($host) if $fetch_mx;
@hosts = ($host) unless @hosts;
foreach my $host (@hosts) {
print $VERB eq 'VRFY' ? "Verify" : "Expand",
"ing $name at $host ($combo):";
$remote = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $host,
PeerPort => "smtp(25)",
);
unless ($remote) {
warn "cannot connect to $host\n";
next;
}
print "\n";
$remote->autoflush(1);
# use CRLF network line terminators
print $remote "HELO $selfname\015\012";
print $remote "$VERB $name\015\012";
print $remote "quit\015\012";
while (<$remote>) {
/^220\b/ && next;
/^221\b/ && last;
s/250\b[\-\s]+//;
print;
}
close($remote) or die "can't close socket: $!";
print "\n"; # if @ARGV;
}
}
#-----------------------------
|