perlipc.1

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

.PP
The Perl function calls for dealing with sockets have the same names as
the corresponding system calls in C, but their arguments tend to differ
for two reasons: first, Perl filehandles work differently than C file
descriptors.  Second, Perl already knows the length of its strings, so you
don't need to pass that information.
.PP
One of the major problems with old socket code in Perl was that it used
hard-coded values for some of the constants, which severely hurt
portability.  If you ever see code that does anything like explicitly
setting \f(CW\*(C`$AF_INET = 2\*(C'\fR, you know you're in for big trouble:  An
immeasurably superior approach is to use the \f(CW\*(C`Socket\*(C'\fR module, which more
reliably grants access to various constants and functions you'll need.
.PP
If you're not writing a server/client for an existing protocol like
\&\s-1NNTP\s0 or \s-1SMTP\s0, you should give some thought to how your server will
know when the client has finished talking, and vice-versa.  Most
protocols are based on one-line messages and responses (so one party
knows the other has finished when a \*(L"\en\*(R" is received) or multi-line
messages and responses that end with a period on an empty line
(\*(L"\en.\en\*(R" terminates a message/response).
.Sh "Internet Line Terminators"
.IX Subsection "Internet Line Terminators"
The Internet line terminator is \*(L"\e015\e012\*(R".  Under \s-1ASCII\s0 variants of
Unix, that could usually be written as \*(L"\er\en\*(R", but under other systems,
\&\*(L"\er\en\*(R" might at times be \*(L"\e015\e015\e012\*(R", \*(L"\e012\e012\e015\*(R", or something
completely different.  The standards specify writing \*(L"\e015\e012\*(R" to be
conformant (be strict in what you provide), but they also recommend
accepting a lone \*(L"\e012\*(R" on input (but be lenient in what you require).
We haven't always been very good about that in the code in this manpage,
but unless you're on a Mac, you'll probably be ok.
.Sh "Internet \s-1TCP\s0 Clients and Servers"
.IX Subsection "Internet TCP Clients and Servers"
Use Internet-domain sockets when you want to do client-server
communication that might extend to machines outside of your own system.
.PP
Here's a sample \s-1TCP\s0 client using Internet-domain sockets:
.PP
.Vb 4
\&    #!/usr/bin/perl \-w
\&    use strict;
\&    use Socket;
\&    my ($remote,$port, $iaddr, $paddr, $proto, $line);
\&
\&    $remote  = shift || \*(Aqlocalhost\*(Aq;
\&    $port    = shift || 2345;  # random port
\&    if ($port =~ /\eD/) { $port = getservbyname($port, \*(Aqtcp\*(Aq) }
\&    die "No port" unless $port;
\&    $iaddr   = inet_aton($remote)               || die "no host: $remote";
\&    $paddr   = sockaddr_in($port, $iaddr);
\&
\&    $proto   = getprotobyname(\*(Aqtcp\*(Aq);
\&    socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
\&    connect(SOCK, $paddr)    || die "connect: $!";
\&    while (defined($line = <SOCK>)) {
\&        print $line;
\&    }
\&
\&    close (SOCK)            || die "close: $!";
\&    exit;
.Ve
.PP
And here's a corresponding server to go along with it.  We'll
leave the address as \s-1INADDR_ANY\s0 so that the kernel can choose
the appropriate interface on multihomed hosts.  If you want sit
on a particular interface (like the external side of a gateway
or firewall machine), you should fill this in with your real address
instead.
.PP
.Vb 6
\&    #!/usr/bin/perl \-Tw
\&    use strict;
\&    BEGIN { $ENV{PATH} = \*(Aq/usr/ucb:/bin\*(Aq }
\&    use Socket;
\&    use Carp;
\&    my $EOL = "\e015\e012";
\&
\&    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\en" }
\&
\&    my $port = shift || 2345;
\&    my $proto = getprotobyname(\*(Aqtcp\*(Aq);
\&
\&    ($port) = $port =~ /^(\ed+)$/                        or die "invalid port";
\&
\&    socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
\&    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
\&                                        pack("l", 1))   || die "setsockopt: $!";
\&    bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
\&    listen(Server,SOMAXCONN)                            || die "listen: $!";
\&
\&    logmsg "server started on port $port";
\&
\&    my $paddr;
\&
\&    $SIG{CHLD} = \e&REAPER;
\&
\&    for ( ; $paddr = accept(Client,Server); close Client) {
\&        my($port,$iaddr) = sockaddr_in($paddr);
\&        my $name = gethostbyaddr($iaddr,AF_INET);
\&
\&        logmsg "connection from $name [",
\&                inet_ntoa($iaddr), "]
\&                at port $port";
\&
\&        print Client "Hello there, $name, it\*(Aqs now ",
\&                        scalar localtime, $EOL;
\&    }
.Ve
.PP
And here's a multithreaded version.  It's multithreaded in that
like most typical servers, it spawns (forks) a slave server to
handle the client request so that the master server can quickly
go back to service a new client.
.PP
.Vb 6
\&    #!/usr/bin/perl \-Tw
\&    use strict;
\&    BEGIN { $ENV{PATH} = \*(Aq/usr/ucb:/bin\*(Aq }
\&    use Socket;
\&    use Carp;
\&    my $EOL = "\e015\e012";
\&
\&    sub spawn;  # forward declaration
\&    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\en" }
\&
\&    my $port = shift || 2345;
\&    my $proto = getprotobyname(\*(Aqtcp\*(Aq);
\&
\&    ($port) = $port =~ /^(\ed+)$/                        or die "invalid port";
\&
\&    socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
\&    setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
\&                                        pack("l", 1))   || die "setsockopt: $!";
\&    bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
\&    listen(Server,SOMAXCONN)                            || die "listen: $!";
\&
\&    logmsg "server started on port $port";
\&
\&    my $waitedpid = 0;
\&    my $paddr;
\&
\&    use POSIX ":sys_wait_h";
\&    use Errno;
\&
\&    sub REAPER {
\&        local $!;   # don\*(Aqt let waitpid() overwrite current error
\&        while ((my $pid = waitpid(\-1,WNOHANG)) > 0 && WIFEXITED($?)) {
\&            logmsg "reaped $waitedpid" . ($? ? " with exit $?" : \*(Aq\*(Aq);
\&        }
\&        $SIG{CHLD} = \e&REAPER;  # loathe sysV
\&    }
\&
\&    $SIG{CHLD} = \e&REAPER;
\&
\&    while(1) {
\&        $paddr = accept(Client, Server) || do {
\&            # try again if accept() returned because a signal was received
\&            next if $!{EINTR};
\&            die "accept: $!";
\&        };
\&        my ($port, $iaddr) = sockaddr_in($paddr);
\&        my $name = gethostbyaddr($iaddr, AF_INET);
\&
\&        logmsg "connection from $name [",
\&               inet_ntoa($iaddr),
\&               "] at port $port";
\&
\&        spawn sub {
\&            $|=1;
\&            print "Hello there, $name, it\*(Aqs now ", scalar localtime, $EOL;
\&            exec \*(Aq/usr/games/fortune\*(Aq       # XXX: \`wrong\*(Aq line terminators
\&                or confess "can\*(Aqt exec fortune: $!";
\&        };
\&        close Client;
\&    }
\&
\&    sub spawn {
\&        my $coderef = shift;
\&
\&        unless (@_ == 0 && $coderef && ref($coderef) eq \*(AqCODE\*(Aq) {
\&            confess "usage: spawn CODEREF";
\&        }
\&
\&        my $pid;
\&        if (! defined($pid = fork)) {
\&            logmsg "cannot fork: $!";
\&            return;
\&        } 
\&        elsif ($pid) {
\&            logmsg "begat $pid";
\&            return; # I\*(Aqm the parent
\&        }
\&        # else I\*(Aqm the child \-\- go spawn
\&
\&        open(STDIN,  "<&Client")   || die "can\*(Aqt dup client to stdin";
\&        open(STDOUT, ">&Client")   || die "can\*(Aqt dup client to stdout";
\&        ## open(STDERR, ">&STDOUT") || die "can\*(Aqt dup stdout to stderr";
\&        exit &$coderef();
\&    }
.Ve
.PP
This server takes the trouble to clone off a child version via \fIfork()\fR
for each incoming request.  That way it can handle many requests at
once, which you might not always want.  Even if you don't \fIfork()\fR, the
\&\fIlisten()\fR will allow that many pending connections.  Forking servers
have to be particularly careful about cleaning up their dead children
(called \*(L"zombies\*(R" in Unix parlance), because otherwise you'll quickly
fill up your process table.  The \s-1REAPER\s0 subroutine is used here to
call \fIwaitpid()\fR for any child processes that have finished, thereby
ensuring that they terminate cleanly and don't join the ranks of the
living dead.
.PP
Within the while loop we call \fIaccept()\fR and check to see if it returns
a false value.  This would normally indicate a system error that needs
to be reported.  However the introduction of safe signals (see
\&\*(L"Deferred Signals (Safe Signals)\*(R" above) in Perl 5.7.3 means that
\&\fIaccept()\fR may also be interrupted when the process receives a signal.
This typically happens when one of the forked sub-processes exits and
notifies the parent process with a \s-1CHLD\s0 signal.
.PP
If \fIaccept()\fR is interrupted by a signal then $! will be set to \s-1EINTR\s0.
If this happens then we can safely continue to the next iteration of
the loop and another call to \fIaccept()\fR.  It is important that your
signal handling code doesn't modify the value of $! or this test will
most likely fail.  In the \s-1REAPER\s0 subroutine we create a local version
of $! before calling \fIwaitpid()\fR.  When \fIwaitpid()\fR sets $! to \s-1ECHILD\s0 (as
it inevitably does when it has no more children waiting), it will
update the local copy leaving the original unchanged.
.PP
We suggest that you use the \fB\-T\fR flag to use taint checking (see perlsec)
even if we aren't running setuid or setgid.  This is always a good idea
for servers and other programs run on behalf of someone else (like \s-1CGI\s0
scripts), because it lessens the chances that people from the outside will
be able to compromise your system.
.PP
Let's look at another \s-1TCP\s0 client.  This one connects to the \s-1TCP\s0 \*(L"time\*(R"
service on a number of different machines and shows how far their clocks
differ from the system on which it's being run:
.PP
.Vb 3
\&    #!/usr/bin/perl  \-w
\&    use strict;
\&    use Socket;
\&
\&    my $SECS_of_70_YEARS = 2208988800;
\&    sub ctime { scalar localtime(shift) }
\&
\&    my $iaddr = gethostbyname(\*(Aqlocalhost\*(Aq);
\&    my $proto = getprotobyname(\*(Aqtcp\*(Aq);
\&    my $port = getservbyname(\*(Aqtime\*(Aq, \*(Aqtcp\*(Aq);
\&    my $paddr = sockaddr_in(0, $iaddr);
\&    my($host);
\&
\&    $| = 1;
\&    printf "%\-24s %8s %s\en",  "localhost", 0, ctime(time());
\&
\&    foreach $host (@ARGV) {
\&        printf "%\-24s ", $host;
\&        my $hisiaddr = inet_aton($host)     || die "unknown host";
\&        my $hispaddr = sockaddr_in($port, $hisiaddr);
\&        socket(SOCKET, PF_INET, SOCK_STREAM, $proto)   || die "socket: $!";
\&        connect(SOCKET, $hispaddr)          || die "bind: $!";
\&        my $rtime = \*(Aq    \*(Aq;
\&        read(SOCKET, $rtime, 4);
\&        close(SOCKET);
\&        my $histime = unpack("N", $rtime) \- $SECS_of_70_YEARS;
\&        printf "%8d %s\en", $histime \- time, ctime($histime);
\&    }
.Ve
.Sh "Unix-Domain \s-1TCP\s0 Clients and Servers"
.IX Subsection "Unix-Domain TCP Clients and Servers"
That's fine for Internet-domain clients and servers, but what about local
communications?  While you can use the same setup, sometimes you don't
want to.  Unix-domain sockets are local to the current host, and are often
used internally to implement pipes.  Unlike Internet domain sockets, Unix
domain sockets can show up in the file system with an \fIls\fR\|(1) listing.
.PP
.Vb 2
\&    % ls \-l /dev/log
\&    srw\-rw\-rw\-  1 root            0 Oct 31 07:23 /dev/log
.Ve
.PP
You can test for these with Perl's \fB\-S\fR file test:
.PP
.Vb 3
\&    unless ( \-S \*(Aq/dev/log\*(Aq ) {
\&        die "something\*(Aqs wicked with the log system";
\&    }
.Ve
.PP
Here's a sample Unix-domain client:
.PP
.Vb 4
\&    #!/usr/bin/perl \-w
\&    use Socket;
\&    use strict;
\&    my ($rendezvous, $line);
\&
\&    $rendezvous = shift || \*(Aqcatsock\*(Aq;
\&    socket(SOCK, PF_UNIX, SOCK_STREAM, 0)       || die "socket: $!";
\&    connect(SOCK, sockaddr_un($rendezvous))     || die "connect: $!";
\&    while (defined($line = <SOCK>)) {
\&        print $line;
\&    }
\&    exit;
.Ve
.PP
And here's a corresponding server.  You don't have to worry about silly
network terminators here because Unix domain sockets are guaranteed
to be on the localhost, and thus everything works right.
.PP
.Vb 4
\&    #!/usr/bin/perl \-Tw
\&    use strict;
\&    use Socket;
\&    use Carp;
\&
\&    BEGIN { $ENV{PATH} = \*(Aq/usr/ucb:/bin\*(Aq }
\&    sub spawn;  # forward declaration
\&    sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\en" }
\&
\&    my $NAME = \*(Aqcatsock\*(Aq;
\&    my $uaddr = sockaddr_un($NAME);
\&    my $proto = getprotobyname(\*(Aqtcp\*(Aq);