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