开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > Telnet服务器 > 查看源码
tcp.pl
资源名称：3.0-20000220-SNAP.tar.gz　[点击查看]
上传用户：minyiyu
上传日期：2018-12-24
资源大小：864k
文件大小：13k
源码类别：

Telnet服务器

开发平台：

Unix_Linux

tcp.pl：源码内容
  1. #!/usr/local/bin/perl
  3. package main;
  4. sub tcp'getostype {
  5.    chop($_=`uname -a`); 
  6.    if ( /^SunOS/i ) {
  7.        ($os,$host,$ver)=split(/s+/,$_);
  8.         if ( $ver =~ /5./ ) {
  9.                 return "Solaris";            
  10.         } else {
  11.                 return "BSD";
  12.         }
  13.    } elsif (/^HP-UX/i) {
  14.         return "SYSV";
  15.    } elsif (/^AIX/i ) {
  16.         return "AIX";
  17.    } elsif (/^OSF1/i) {
  18.         return "SYSV";
  19.    }
  20. }
  21. $tcp'OS = &tcp'getostype();
  22. if ( $OS eq "Solaris") {
  23.       eval 'sub SOCK_STREAM {2;}';
  24.       eval 'sub SOCK_DGRAM {1;}';
  25.     } else {
  26.       eval 'sub SOCK_STREAM {1;}';
  27.       eval 'sub SOCK_DGRAM {2;}';
  28.     }
  29.     eval 'sub SOCK_RAW {3;}';
  30.     eval 'sub SOCK_RDM {4;}';
  31.     eval 'sub SOCK_SEQPACKET {5;}';
  32.     eval 'sub SO_DEBUG {0x0001;}';
  33.     eval 'sub SO_ACCEPTCONN {0x0002;}';
  34.     eval 'sub SO_REUSEADDR {0x0004;}';
  35.     eval 'sub SO_KEEPALIVE {0x0008;}';
  36.     eval 'sub SO_DONTROUTE {0x0010;}';
  37.     eval 'sub SO_BROADCAST {0x0020;}';
  38.     eval 'sub SO_USELOOPBACK {0x0040;}';
  39.     eval 'sub SO_LINGER {0x0080;}';
  40.     eval 'sub SO_OOBINLINE {0x0100;}';
  41.     eval 'sub SO_DONTLINGER {(~ &SO_LINGER);}';
  42.     eval 'sub SO_SNDBUF {0x1001;}';
  43.     eval 'sub SO_RCVBUF {0x1002;}';
  44.     eval 'sub SO_SNDLOWAT {0x1003;}';
  45.     eval 'sub SO_RCVLOWAT {0x1004;}';
  46.     eval 'sub SO_SNDTIMEO {0x1005;}';
  47.     eval 'sub SO_RCVTIMEO {0x1006;}';
  48.     eval 'sub SO_ERROR {0x1007;}';
  49.     eval 'sub SO_TYPE {0x1008;}';
  50.     eval 'sub SOL_SOCKET {0xffff;}';
  51.     eval 'sub AF_UNSPEC {0;}';
  52.     eval 'sub AF_UNIX {1;}';
  53.     eval 'sub AF_INET {2;}';
  54.     eval 'sub AF_IMPLINK {3;}';
  55.     eval 'sub AF_PUP {4;}';
  56.     eval 'sub AF_CHAOS {5;}';
  57.     eval 'sub AF_NS {6;}';
  58.     eval 'sub AF_NBS {7;}';
  59.     eval 'sub AF_ECMA {8;}';
  60.     eval 'sub AF_DATAKIT {9;}';
  61.     eval 'sub AF_CCITT {10;}';
  62.     eval 'sub AF_SNA {11;}';
  63.     eval 'sub AF_DECnet {12;}';
  64.     eval 'sub AF_DLI {13;}';
  65.     eval 'sub AF_LAT {14;}';
  66.     eval 'sub AF_HYLINK {15;}';
  67.     eval 'sub AF_APPLETALK {16;}';
  68.     eval 'sub AF_NIT {17;}';
  69.     eval 'sub AF_802 {18;}';
  70.     eval 'sub AF_OSI {19;}';
  71.     eval 'sub AF_X25 {20;}';
  72.     eval 'sub AF_OSINET {21;}';
  73.     eval 'sub AF_GOSIP {22;}';
  74.     eval 'sub AF_MAX {21;}';
  75.     eval 'sub PF_UNSPEC { &AF_UNSPEC;}';
  76.     eval 'sub PF_UNIX { &AF_UNIX;}';
  77.     eval 'sub PF_INET { &AF_INET;}';
  78.     eval 'sub PF_IMPLINK { &AF_IMPLINK;}';
  79.     eval 'sub PF_PUP { &AF_PUP;}';
  80.     eval 'sub PF_CHAOS { &AF_CHAOS;}';
  81.     eval 'sub PF_NS { &AF_NS;}';
  82.     eval 'sub PF_NBS { &AF_NBS;}';
  83.     eval 'sub PF_ECMA { &AF_ECMA;}';
  84.     eval 'sub PF_DATAKIT { &AF_DATAKIT;}';
  85.     eval 'sub PF_CCITT { &AF_CCITT;}';
  86.     eval 'sub PF_SNA { &AF_SNA;}';
  87.     eval 'sub PF_DECnet { &AF_DECnet;}';
  88.     eval 'sub PF_DLI { &AF_DLI;}';
  89.     eval 'sub PF_LAT { &AF_LAT;}';
  90.     eval 'sub PF_HYLINK { &AF_HYLINK;}';
  91.     eval 'sub PF_APPLETALK { &AF_APPLETALK;}';
  92.     eval 'sub PF_NIT { &AF_NIT;}';
  93.     eval 'sub PF_802 { &AF_802;}';
  94.     eval 'sub PF_OSI { &AF_OSI;}';
  95.     eval 'sub PF_X25 { &AF_X25;}';
  96.     eval 'sub PF_OSINET { &AF_OSINET;}';
  97.     eval 'sub PF_GOSIP { &AF_GOSIP;}';
  98.     eval 'sub PF_MAX { &AF_MAX;}';
  99.     eval 'sub SOMAXCONN {5;}';
  100.     eval 'sub MSG_OOB {0x1;}';
  101.     eval 'sub MSG_PEEK {0x2;}';
  102.     eval 'sub MSG_DONTROUTE {0x4;}';
  103.     eval 'sub MSG_MAXIOVLEN {16;}';
  105. #package tcp;
  107. $defaultport = 'nntp';
  108. $defaultserver = 'ccsun35.csie.nctu.edu.tw.';
  109. $ENV{'PATH'}='/bin:/usr/ucb:/usr/etc';
  111. # The Internet TCP client algorithm 
  112. # 1. Find the IP address and protocol port number of the server
  113. #    with which communication is desired. (gethostbyname,getservbyname)
  114. # 2. Allocate a socket.  (socket)
  115. # 3. Specify that the connection needs an arbitary, unsed protocol
  116. #    port on the local machine, and allow TCP to choose one. (bind)
  117. # 4. Connect the socket to the server. (connect)
  118. # 5. Communicate with the server using the application-level protocol
  119. #    (this usually involves sending requests and awaiting replies)
  120. # 6. close the connection.
  121. #    
  122. # reference: 
  123. # socket addr, internet style structure for Sun-OS
  124. # include <netinet/in.h>
  125. # struct sockaddr_in {
  126. #   short   sin_family;
  127. #   u_short sin_port;
  128. #   struct  in_addr sin_addr;
  129. #   char    sin_zero[8];
  130. # }
  131. # ( 'S n a4 x8' template for perl pack)
  132. # Usage
  133. # &tcpinetclient(FILEHANDLE[,hostname,portno]);
  134. # for example,
  135. # &tcpinetclient(NNTP,'news.csie.nctu.edu.tw','nntp');
  136. # print NNTP "helprn";
  137. # $_ = <NNTP>;
  138. # print;
  140. sub main'tcpinetclient {
  141.   local(*S,$server,$port)=@_;
  142.   $port = $defaultport unless $port; 
  143.   $server = $defaultserver unless $server; 
  144.   local($hostname);
  145.   chop($hostname = `hostname`);
  146.   local($sockaddr)= 'S n a4 x8';
  147.   local($name,$aliases,$proto)=getprotobyname('tcp');
  148.   local($name,$aliases,$port)=getservbyname($port,'tcp')
  149. unless $port =~ /^d+$/;
  150. #  print "port number in tcpinetclient $portn";
  151.   local($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  152.   local($name, $aliases, $type, $len, $thataddr) = gethostbyname($server);
  153.   socket(S, &main'PF_INET, &main'SOCK_STREAM, $proto) || die "socket: $!";
  154.   local($this) = pack($sockaddr, &main'AF_INET, 0, $thisaddr);
  155. # accept connect from any port (0)   
  156.   local($that) = pack($sockaddr, &main'AF_INET, $port, $thataddr);
  157. # bind(S, $this) || die "bind to $hostname: $!";
  158.   connect(S, $that) || die "connect to $port: $!";
  159.   select(S); $| = 1; select(STDOUT);
  160.   1;
  161. }
  164. # reference: socket for unix domain in Sun-OS
  165. # include <socket.h>
  166. # struct sockaddr {
  167. #   u_short sa_family;
  168. #   char    sa_data[14];
  169. # }
  170. # ('S a14' perl template for perl) 
  171. # usage
  172. # &tcpunixclient(FILEHANDLE,path);
  173. # for example,
  174. # &tcpunixclient(LOCAL,"/tmp/unixsock$$");
  176. #$defaultpath="/tmp/unixsock$$";
  177. $defaultpath='/tmp/sample';
  178. # only 14 chars can be used
  179. sub main'tcpunixclient {
  180.   local(*S,$path)=@_;
  181.   $path = $defaultpath unless $path; 
  182.   local($sockaddr)= 'S a14';
  183.   socket(S, &PF_UNIX, &SOCK_STREAM, 0) || die "socket: $!";
  184.   $that = pack($sockaddr, &AF_INET, $path);
  185.   connect(S, $that) || die "connect to $path: $!";
  186.   select(S); $| = 1; select(STDOUT);
  187.   1;
  188. }
  191. # o Interactive, Connection-Orientd Server
  192. # o Interactive, Connectionless Server
  193. # o Concurrent, Connectionless Server 
  194. #   server repeatedly call "recvform" and let slave use "sendto"
  195. #   to reply the client.
  196. # o concurrent, connection-oriented server algorithm
  197. # Master 1. Create a socket and bind to the well-known address
  198. #     for the service being offered. Leave the socket unconnected
  199. #     (socket,bind)
  200. # Master 2. Place the socket in passive mode, makeing it ready for used
  201. #     by a server. (listen)
  202. # Master 3. Repeatedly call accept to receive the next request from
  203. #     a client, and create a new slave process to handle the  
  204. #     response.  (accept)
  205. # Slave  1. Receive a connection request (i.e., socket for the connection)
  206. #     upon creation.
  207. # Slave  2. Interact with the client using the connection: read request(s)
  208. #     and send back response(s).
  209. # Slave  3. Close the connection and exit. The slave process exits
  210. #     after handling all requests from one client.
  211. #
  212. # Usage
  213. # &tcpinetserver([port-no,service-routine,before,each]);
  214. # for example
  215. # &tcpinetserver(1234,'simple_service');
  216. #
  218. $defaultserverport=1234;
  219. $defaultserviceroutine="simple_service";
  221. sub simple_service {
  222. local(*S)=@_;
  223. while (<S>) {
  224. if (/quit/) {
  225. return(0);
  226. } elsif (/help/) {
  227. print S <<"EOF";
  228. This is a simple sample server r
  229. available command r
  230. help quit r
  231. EOF
  232. } else {
  233. print S "Unknown commandrn";
  234. }
  235. }
  236. }
  238. sub reapchild {
  239. while (waitpid(-1,&WNOHANG|&WUNTRACED)>0) {
  240. # print "reapchildn";
  241. # while (waitpid(-1,&WNOHANG)>0) {
  242. # print "reaping childn";
  243. next;
  244. }
  245. 1;
  246. }
  247. #sub reapchild {
  248. # while (1) {
  249. # $pid = waitpid(-1,&WNOHANG);
  250. # last if ($pid < 1);
  251. # }
  252. #}
  254. sub dokill {
  255. kill 9,0;
  256. }
  258. sub main'tcpinetserver {
  259.   local($port,$service,$before,$each)=@_;
  260.   if ($port != 0) {
  261.     $port = $defaultserverport unless $port; 
  262.   }
  263.   $service = $defaultserviceroutine unless $service; 
  264.   local($sockaddr)= 'S n a4 x8';
  265.   local($name,$aliases,$proto)=getprotobyname('tcp');
  266.   local($name,$aliases,$port)=getservbyname($port,'tcp')
  267. unless $port =~ /^d+$/;
  268.   local(*S,*NS);
  269.   chdir("/");
  270.   socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  271.   setsockopt(S,main'SOL_SOCKET,main'SO_REUSEADDR,1);
  272.   setsockopt(S,main'SOL_SOCKET,main'SO_LINGER,0);
  273.   if ($port == 0) {
  274.     local($hostname); 
  275.     chop($hostname = `hostname`);
  276.     local($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  277.   } else {
  278. $thisaddr = "";
  279.   }
  280.   $this = pack($sockaddr, &AF_INET, $port, $thisaddr);
  281.   # can accept connection from $port, to any port in client
  282.   bind(S, $this) || die "bind: $!";
  283.   select(S); $| = 1; select(STDOUT);
  284.   $SIG{'CHLD'} = 'reapchild';
  285.   $SIG{'HUP'} = 'IGNORE';
  286.   $SIG{'INT'} = 'dokill';
  287.   $SIG{'TERM'} = 'dokill';
  289.   do $before(S) if ($before);
  290.   listen(S, 5) || die "connect: $!";
  291.   for (;;) {
  292. #    print "Listening againn";
  293.     ($addr = accept(NS,S)) || next;  
  294. # || die "accept: $!n";
  295.     select(NS); $| = 1; select(STDOUT);
  296. #    print "accept okn";
  297.     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  298.     @inetaddr = unpack('C4',$inetaddr);
  299. #    print "$af $port @inetaddrn";
  300.     FORK: {
  301. last if ( $pid = fork) ;
  302.   if (defined $pid) {
  303. close(S);
  304.      $return = do $service(NS);
  305. close(NS);
  306. exit($return);
  307. }
  308. if ($! =~ /No more process/) {
  309. sleep 5;
  310. redo FORK;
  311. } else {
  312. die "Can't fork: $!n";
  313. }
  314.     } # FORK
  315.     do $each(NS) if ($each);
  316.     close(NS);
  317.   } # listen forever and fork a client to handle service request
  318. } # end tcpinetserver
  320. # single proecess, connection-oriented server for internet
  321. sub main'tcpinetsingleserver {
  322.   local($port,$service,$beforeservice,$each)=@_;
  323.   if ( $port != 0) {
  324.     $port = $defaultserverport unless $port; 
  325.   }
  326.   $service = $defaultserviceroutine unless $service; 
  327.   local($sockaddr)= 'S n a4 x8';
  328.   local($name,$aliases,$proto)=getprotobyname('tcp');
  329.   local($name,$aliases,$port)=getservbyname($port,'tcp')
  330. unless $port =~ /^d+$/;
  331.   local(*S,*NS);
  332.   chdir("/");
  333.   socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  334.   if ($port == 0) {
  335.     local($hostname); 
  336.     chop($hostname = `hostname`);
  337.     local($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
  338.   } else {
  339. $thisaddr = "";
  340.   }
  341.   $this = pack($sockaddr, &AF_INET, $port, $thisaddr);
  342.   # can accept connection from $port, to any port in client
  343.   bind(S, $this) || die "bind: $!";
  344.   select(S); $| = 1; select(STDOUT);
  345.   $SIG{'CHLD'} = 'reapchild';
  346.   $SIG{'HUP'} = 'IGNORE';
  347.   $SIG{'INT'} = 'dokill';
  348.   do $beforeservice(S) if ($beforeservice);
  349.   listen(S, 5) || die "connect: $!";
  350.   for (;;) {
  351. #    print "Listening again in single servern";
  352.     ($addr = accept(NS,S)) || next;  
  353.     select(NS); $| = 1; select(STDOUT);
  354. #    print "accept okn";
  355.     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  356.     @inetaddr = unpack('C4',$inetaddr);
  357. #    print "$af $port @inetaddrn";
  358.     $return = do $service(NS);
  359.     do $each(NS) if ($each);
  360.     close(NS);
  361.   }
  362. }
  364. # Concurrent, Connection-oriented server for UNIX domain
  365. $path=$defaultpath;
  366. sub doremove {
  367. unlink $path;
  368. kill 9,0;
  369. }
  371. sub simple_unixservice {
  372. local(*S)=@_;
  373. while (<S>) {
  374. if (/quit/) {
  375. return(0);
  376. } elsif (/help/) {
  377. print S <<"EOF";
  378. This is a simple sample server r
  379. available command r
  380. help quit r
  381. EOF
  382. } else {
  383. print S "Unknown commandrn";
  384. }
  385. }
  386. }
  388. sub main'tcpunixserver {
  389.   ($path,$service)=@_;
  390.   $path = $defaultpath unless $path; 
  391.   $service = 'simple_unixservice' unless $service; 
  392.   local($sockaddr)= 'S a14';
  393.   socket(S, &PF_UNIX, &SOCK_STREAM, 0) || die "socket: $!";
  394.   $this = pack($sockaddr, &AF_INET, $path);
  395.   bind(S, $this) || die "bind: $!";
  396.   select(S); $| = 1; select(STDOUT);
  397.   $SIG{'CHLD'} = 'reapchild';
  398.   $SIG{'HUP'} = 'IGNORE';
  399.   $SIG{'INT'} = 'doremove';
  400.   $SIG{'TERM'} = 'doremove';
  402.   for (;;) {
  403.     listen(S, 5) || die "connect: $!";
  404. #    print "Listening againn";
  405.     ($addr = accept(NS,S)) || next;
  406.     select(NS); $| = 1; select(STDOUT);
  407. #    print "accept okn";
  408.     FORK: {
  409. last if ( $pid = fork) ;
  410.   if (defined $pid) {
  411. close(S);
  412.      $return = do $service(NS);
  413. close(NS);
  414. exit($return);
  415. }
  416. if ($! =~ /No more process/) {
  417. sleep 5;
  418. redo FORK;
  419. } else {
  420. die "Can't fork: $!n";
  421. }
  422.     } # FORK
  423.     close(NS);
  424.  }
  425. }
  427. sub main'simpleunixclient {
  428. local($path)= @_;
  429. local(*S,$rin,$rout);
  430. ($path)= $defaultpath unless $path;
  431. &tcpunixclient(S,$path) || die "can't connect: $!n";
  432. $rin='';
  433. vec($rin,fileno(STDIN),1)=1;
  434. vec($rin,fileno(S),1)=1;
  435. for (;;) {
  436. (($nf=select($rout=$rin,undef,undef,undef))>=0) || die "select: $!n";
  437. if (vec($rout,fileno(S),1)) {
  438. $i=read(S,$n,1);
  439. if ($i) {
  440. print $n;
  441. } else {
  442. print "byen";
  443. last;
  444. }
  445. }
  446. if (vec($rout,fileno(STDIN),1)) {
  447. $_ = <STDIN>;
  448. chop;
  449. print S $_,"rn";
  450. }
  451. }
  452. }
  454. sub main'remotehostname {
  455.     (*WNRP) = @_;
  456.     local($there,$here)=(getpeername(WNRP),getsockname(WNRP));
  457.     local($sockaddr)= 'S n a4 x8';
  458.     local($family,$thisport,$thisaddr)=unpack($sockaddr,$here);
  459.     local($family,$thatport,$thataddr)=unpack($sockaddr,$there);
  460.     local(@localaddr)=unpack('C4',$thisaddr);
  461.     local(@remoteaddr)=unpack('C4',$thataddr);
  462.     local($hostname)=gethostbyaddr($thisaddr,&AF_INET);
  463.     local($remotehostname)=gethostbyaddr($thataddr,&AF_INET);
  464.     return ($remotehostname);
  465. }