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

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

Telnet服务器

开发平台：

Unix_Linux

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