用SOCKET来传输文件的PERL脚本

huijial

　　From:http://www.cnitblog.com/gyn/archive/2006/04/06/8824.html
　　Client:
　　#!/usr/bin/perl
#===============================================================================
#
#         FILE:  file_trans_clt.pl
#
#        USAGE:  ./file_trans_clt.pl  
#
#  DESCRIPTION:  
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  YOUR NAME (),
#      COMPANY:  
#      VERSION:  1.0
#      CREATED:  07/12/2010 07:07:25 PM
#     REVISION:  ---
#===============================================================================
use strict;
use warnings;
my $port=$ARGV[0];
my $file=$ARGV[1];
my $PF_INET=2;
my $SOCK_STREAM=1;
my $remote_addr=pack('SnC4x8',$PF_INET,$port,127,0,0,1);
socket(FILE_TRANS_CLIENT,$PF_INET,$SOCK_STREAM,getprotobyname('tcp')) or die("socket failed for $!");
open(SFILE,">$file") or die("file creation failed for $!");
binmode(SFILE);
connect(FILE_TRANS_CLIENT,$remote_addr) or die("connection failed for $!");
while(<FILE_TRANS_CLIENT>){
print SFILE $_;
}
close(FILE_TRANS_CLIENT);
close(SFILE);

　　Server:
　　#!/usr/bin/perl
#===============================================================================
#
#         FILE:  file_trans_srv.pl
#
#        USAGE:  ./file_trans_srv.pl  
#
#  DESCRIPTION:  
#
#      OPTIONS:  ---
# REQUIREMENTS:  ---
#         BUGS:  ---
#        NOTES:  ---
#       AUTHOR:  YOUR NAME (),
#      COMPANY:  
#      VERSION:  1.0
#      CREATED:  07/12/2010 06:58:00 PM
#     REVISION:  ---
#===============================================================================
use strict;
use warnings;
my $port=$ARGV[0];
my $file=$ARGV[1];
my $PF_INET=2;
my $SOCK_STREAM=1;
my $local_addr=pack('SnC4x8',$PF_INET,$port,127,0,0,1);
socket(FILE_TRANS_SERV,$PF_INET,$SOCK_STREAM,getprotobyname('tcp')) or die("socket failed for $!");
bind(FILE_TRANS_SERV,$local_addr) or die("bind failed for $!");
listen(FILE_TRANS_SERV,3);
open(FILE,$file) or die("open failed for $!");
binmode(FILE);
seek(FILE,0,0);
for(;my $remote_addr=accept(FILE_TRANS_CLIENT,FILE_TRANS_SERV);close(FILE_TRANS_CLIENT)){
while(!eof(FILE)){
read(FILE,my $buffer,100);
send(FILE_TRANS_CLIENT,$buffer,0);
}#while
}#for
close(FILE_TRANS_SERV);
close(FILE);

　　注：pack函数：http://perl.active-venture.com/pod/func/pack.html
　　

Back to Index pack pack TEMPLATE,LIST 　　Takes a LIST of values and converts it into a string using the rules given by the TEMPLATE. The resulting string is the concatenation of the converted values. Typically, each converted value looks like its machine-level representation. For example, on 32-bit machines a converted integer may be represented by a sequence of 4 bytes. 　　The TEMPLATE is a sequence of characters that give the order and type of values, as follows: 　　     aA string with arbitrary binary data, will be null padded. AA text (ASCII) string, will be space padded. ZA null terminated (ASCIZ) string, will be null padded. bA bit string (ascending bit order inside each byte, like vec()). BA bit string (descending bit order inside each byte). hA hex string (low nybble first). HA hex string (high nybble first). cA signed char value. CAn unsigned char value.  Only does bytes.  See U for Unicode. sA signed short value. SAn unsigned short value. (This 'short' is _exactly_ 16 bits, which may differ from what a local C compiler calls 'short'.  If you want native-length shorts, use the '!' suffix.) iA signed integer value. IAn unsigned integer value. (This 'integer' is _at_least_ 32 bits wide.  Its exact size depends on what a local C compiler calls 'int', and may even be larger than the 'long' described in the next item.) lA signed long value. LAn unsigned long value. (This 'long' is _exactly_ 32 bits, which may differ from what a local C compiler calls 'long'.  If you want native-length longs, use the '!' suffix.) nAn unsigned short in "network" (big-endian) order. NAn unsigned long in "network" (big-endian) order. vAn unsigned short in "VAX" (little-endian) order. VAn unsigned long in "VAX" (little-endian) order. (These 'shorts' and 'longs' are _exactly_ 16 bits and _exactly_ 32 bits, respectively.) qA signed quad (64-bit) value. QAn unsigned quad value. (Quads are available only if your system supports 64-bit integer values _and_ if Perl has been compiled to support those. Causes a fatal error otherwise.) j   A signed integer value (a Perl internal integer, IV). J   An unsigned integer value (a Perl internal unsigned integer, UV). fA single-precision float in the native format. dA double-precision float in the native format. FA floating point value in the native native format (a Perl internal floating point value, NV). DA long double-precision float in the native format. (Long doubles are available only if your system supports long double values _and_ if Perl has been compiled to support those. Causes a fatal error otherwise.) pA pointer to a null-terminated string. PA pointer to a structure (fixed-length string). uA uuencoded string. UA Unicode character number.  Encodes to UTF-8 internally (or UTF-EBCDIC in EBCDIC platforms). wA BER compressed integer.  Its bytes represent an unsigned integer in base 128, most significant digit first, with as few digits as possible.  Bit eight (the high bit) is set on each byte except the last. xA null byte. XBack up a byte. @Null fill to absolute position. (Start of a ()-group.   　　The following rules apply: 　　Each letter may optionally be followed by a number giving a repeat count. With all types excepta,A,Z,b,B,h,H,@,x,XandPthe pack function will gobble up that many values from the LIST. A*for the repeat count means to use however many items are left, except for@,x,X, where it is equivalent to0, andu, where it is equivalent to 1 (or 45, what is the same). A numeric repeat count may optionally be enclosed in brackets, as inpack 'C[80]', @arr. 　　One can replace the numeric repeat count by a template enclosed in brackets; then the packed length of this template in bytes is used as a count. For example,x[L]skips a long (it skips the number of bytes in a long); the template$t X[$t] $tunpack()s twice what $t unpacks. If the template in brackets contains alignment commands (such asx![d]), its packed length is calculated as if the start of the template has the maximal possible alignment. 　　When used withZ,*results in the addition of a trailing null byte (so the packed result will be one longer than the bytelengthof the item). 　　The repeat count foruis interpreted as the maximal number of bytes to encode per line of output, with 0 and 1 replaced by 45. 　　Thea,A, andZtypes gobble just one value, but pack it as a string of length count, padding with nulls or spaces as necessary. When unpacking,Astrips trailing spaces and nulls,Zstrips everything after the first null, andareturns data verbatim. When packing,a, andZare equivalent. 　　If the value-to-pack is too long, it is truncated. If too long and an explicit count is provided,Zpacks only$count-1bytes, followed by a null byte. ThusZalways packs a trailing null byte under all circumstances. 　　Likewise, thebandBfields pack a string that many bits long. Each byte of the input field of pack() generates 1 bit of the result. Each result bit is based on the least-significant bit of the corresponding input byte, i.e., onord($byte)%2. In particular, bytes"0"and"1"generate bits 0 and 1, as do bytes"/0"and"/1". 　　Starting from the beginning of the input string of pack(), each 8-tuple of bytes is converted to 1 byte of output. With formatbthe first byte of the 8-tuple determines the least-significant bit of a byte, and with formatBit determines the most-significant bit of a byte. 　　If the length of the input string is not exactly divisible by 8, the remainder is packed as if the input string were padded by null bytes at the end. Similarly, during unpack()ing the "extra" bits are ignored. 　　If the input string of pack() is longer than needed, extra bytes are ignored. A*for the repeat count of pack() means to use all the bytes of the input field. On unpack()ing the bits are converted to a string of"0"s and"1"s. 　　ThehandHfields pack a string that many nybbles (4-bit groups, representable as hexadecimal digits, 0-9a-f) long. 　　Each byte of the input field of pack() generates 4 bits of the result. For non-alphabetical bytes the result is based on the 4 least-significant bits of the input byte, i.e., onord($byte)%16. In particular, bytes"0"and"1"generate nybbles 0 and 1, as do bytes"/0"and"/1". For bytes"a".."f"and"A".."F"the result is compatible with the usual hexadecimal digits, so that"a"and"A"both generate the nybble0xa==10. The result for bytes"g".."z"and"G".."Z"is not well-defined. 　　Starting from the beginning of the input string of pack(), each pair of bytes is converted to 1 byte of output. With formaththe first byte of the pair determines the least-significant nybble of the output byte, and with formatHit determines the most-significant nybble. 　　If the length of the input string is not even, it behaves as if padded by a null byte at the end. Similarly, during unpack()ing the "extra" nybbles are ignored. 　　If the input string of pack() is longer than needed, extra bytes are ignored. A*for the repeat count of pack() means to use all the bytes of the input field. On unpack()ing the bits are converted to a string of hexadecimal digits. Theptype packs a pointer to a null-terminated string. You are responsible for ensuring the string is not a temporary value (which can potentially get deallocated before you get around to using the packed result). ThePtype packs a pointer to a structure of the size indicated by the length. A NULL pointer is created if the corresponding value forporPisundef, similarly for unpack(). 　　The/template character allows packing and unpacking of strings where the packed structure contains a byte count followed by the string itself. You writelength-item/string-item. 　　Thelength-itemcan be anypacktemplate letter, and describes how the length value is packed. The ones likely to be of most use are integer-packing ones liken(for Java strings),w(for ASN.1 or SNMP) andN(for Sun XDR). 　　Thestring-itemmust, at present, be"A*","a*"or"Z*". Forunpackthe length of the string is obtained from thelength-item, but if you put in the '*' it will be ignored. 　　     unpack 'C/a', "/04Gurusamy";        gives 'Guru' unpack 'a3/A* A*', '007 Bond  J ';  gives (' Bond','J') pack 'n/a* w/a*','hello,','world';  gives "/000/006hello,/005world"   　　Thelength-itemis not returned explicitly fromunpack. 　　Adding a count to thelength-itemletter is unlikely to do anything useful, unless that letter isA,aorZ. Packing with alength-itemofaorZmay introduce"/000"characters, which Perl does not regard as legal in numeric strings. 　　The integer typess,S,l, andLmay be immediately followed by a!suffix to signify native shorts or longs--as you can see from above for example a bareldoes mean exactly 32 bits, the nativelong(as seen by the local C compiler) may be larger. This is an issue mainly in 64-bit platforms. You can see whether using!makes any difference by 　　 print length(pack("s")), " ", length(pack("s!")), "/n"; print length(pack("l")), " ", length(pack("l!")), "/n";   　　i!andI!also work but only because of completeness; they are identical toiandI. 　　The actual sizes (in bytes) of native shorts, ints, longs, and long longs on the platform where Perl was built are also available viaConfig: 　　        use Config; print $Config{shortsize},    "/n"; print $Config{intsize},      "/n"; print $Config{longsize},     "/n"; print $Config{longlongsize}, "/n";   　　(The$Config{longlongsize}will be undefine if your system does not support long longs.) 　　The integer formatss,S,i,I,l,L,j, andJare inherently non-portable between processors and operating systems because they obey the native byteorder and endianness. For example a 4-byte integer 0x12345678 (305419896 decimal) would be ordered natively (arranged in and handled by the CPU registers) into bytes as 　　 0x12 0x34 0x56 0x78# big-endian 0x78 0x56 0x34 0x12# little-endian   　　Basically, the Intel and VAX CPUs are little-endian, while everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA, Power, and Cray are big-endian. Alpha and MIPS can be either: Digital/Compaq used/uses them in little-endian mode; SGI/Cray uses them in big-endian mode. 　　The names `big-endian' and `little-endian' are comic references to the classic "Gulliver's Travels" (via the paper "On Holy Wars and a Plea for Peace" by Danny Cohen, USC/ISI IEN 137, April 1, 1980) and the egg-eating habits of the Lilliputians. 　　Some systems may have even weirder byte orders such as 　　 0x56 0x78 0x12 0x34 0x34 0x12 0x78 0x56   　　You can see your system's preference with 　　 print join(" ", map { sprintf "%#02x", $_ } unpack("C*",pack("L",0x12345678))), "/n";   　　The byteorder on the platform where Perl was built is also available viaConfig: 　　 use Config; print $Config{byteorder}, "/n";   　　Byteorders'1234'and'12345678'are little-endian,'4321'and'87654321'are big-endian. 　　If you want portable packed integers use the formatsn,N,v, andV, their byte endianness and size are known. See alsoperlport. 　　Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard "network" representation, no facility for interchange has been made. This means that packed floating point data written on one machine may not be readable on another - even if both use IEEE floating point arithmetic (as the endian-ness of the memory representation is not part of the IEEE spec). See alsoperlport. 　　Note that Perl uses doubles internally for all numeric calculation, and converting from double into float and thence back to double again will lose precision (i.e.,unpack("f", pack("f", $foo)) will not in general equal $foo). If the pattern begins with aU, the resulting string will be treated as Unicode-encoded. You can force UTF8 encoding on in a string with an initialU0, and the bytes that follow will be interpreted as Unicode characters. If you don't want this to happen, you can begin your pattern withC0(or anything else) to force Perl not to UTF8 encode your string, and then follow this with aU*somewhere in your pattern. You must yourself do any alignment or padding by inserting for example enough'x'es while packing. There is no way to pack() and unpack() could know where the bytes are going to or coming from. Thereforepack(andunpack) handle their output and input as flat sequences of bytes. A ()-group is a sub-TEMPLATE enclosed in parentheses. A group may take a repeat count, both as postfix, and via the/template character. 　　xandXaccept!modifier. In this case they act as alignment commands: they jump forward/back to the closest position aligned at a multiple ofcountbytes. For example, to pack() or unpack() C'sstruct {char c; double d; char cc[2]}one may need to use the templateC x![d] d C[2]; this assumes that doubles must be aligned on the double's size. 　　For alignment commandscountof 0 is equivalent tocountof 1; both result in no-ops. A comment in a TEMPLATE starts with#and goes to the end of line. If TEMPLATE requires more arguments to pack() than actually given, pack() assumes additional""arguments. If TEMPLATE requires less arguments to pack() than actually given, extra arguments are ignored. 　　Examples: 　　     $foo = pack("CCCC",65,66,67,68); # foo eq "ABCD" $foo = pack("C4",65,66,67,68); # same thing $foo = pack("U4",0x24b6,0x24b7,0x24b8,0x24b9); # same thing with Unicode circled letters $foo = pack("ccxxcc",65,66,67,68); # foo eq "AB/0/0CD" # note: the above examples featuring "C" and "c" are true # only on ASCII and ASCII-derived systems such as ISO Latin 1 # and UTF-8.  In EBCDIC the first example would be # $foo = pack("CCCC",193,194,195,196); $foo = pack("s2",1,2); # "/1/0/2/0" on little-endian # "/0/1/0/2" on big-endian $foo = pack("a4","abcd","x","y","z"); # "abcd" $foo = pack("aaaa","abcd","x","y","z"); # "axyz" $foo = pack("a14","abcdefg"); # "abcdefg/0/0/0/0/0/0/0" $foo = pack("i9pl", gmtime); # a real struct tm (on my system anyway) $utmp_template = "Z8 Z8 Z16 L"; $utmp = pack($utmp_template, @utmp1); # a struct utmp (BSDish) @utmp2 = unpack($utmp_template, $utmp); # "@utmp1" eq "@utmp2" sub bintodec { unpack("N", pack("B32", substr("0" x 32 . shift, -32))); } $foo = pack('sx2l', 12, 34); # short 12, two zero bytes padding, long 34 $bar = pack('s@4l', 12, 34); # short 12, zero fill to position 4, long 34 # $foo eq $bar   　　The same template may generally also be used in unpack().