home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / sockperl.zip / eval_cry.nf < prev    next >
Text File  |  1995-03-19  |  3KB  |  133 lines
  1. # os/2 server built to run simple perl scripts from a des
  2. # encrypted socket connection. Hacked from the 'Camel book'
  3. # server and client scripts. Modifications are mostly to 
  4. # deal with 'fork()'ed processes not inheriting socket handles
  5. # (hence the use of a second socket address for the reply!)
  6. # Use of des is just for an interesting example, and to test
  7. # use of piped io.
  8.  
  9. #print "tell me a secret to decrypt the socket: \033[47m";
  10. #$sec=(<>);
  11. #print "\033[44m";
  12.  
  13. ($port) = @ARGV;
  14. $port = 12345678 unless $port;
  15. $port2 = 12345679 ;
  16.  
  17. $AF_INET = 2;
  18. $SOCK_STREAM = 1;
  19.  
  20. $sockaddr = 'S n a4 x8';
  21.  
  22. ($name, $aliases, $proto) = getprotobyname('tcp');
  23. if ($port !~ /^\d+$/) {
  24.     ($name, $aliases, $port) = getservbyport($port, 'tcp');
  25. }
  26.  
  27. print "Port = $port\n";
  28.  
  29. $this = pack($sockaddr, $AF_INET, $port, "\0\0\0\0");
  30.  
  31. select(NS); $| = 1; select (stdout);
  32.  
  33. socket(S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
  34. bind(S,$this) || die "bind: $!";
  35. listen(S,5) || die "connect: $!";
  36.  
  37.  
  38. select(S); $| = 1; select(stdout);
  39.  
  40. $con = 0;
  41. print "Listening for connection 1....\n";
  42. #for(;;) {
  43.  
  44.  
  45.     ($addr = accept(NS,S)) || die $!;
  46.  
  47.     $con++;
  48. #    if (($child[$con] = fork()) == 0) {
  49.     print "accept ok\n";
  50.  
  51.     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
  52.     @inetaddr = unpack('C4',$inetaddr);
  53.     print "$con: $af $port @inetaddr\n";
  54.  
  55.     @cyphert = <NS>;
  56.     open (C_TEMP, ">$ENV{TMP}/tmp$$") || warn "cant open TEMP ";
  57.     print C_TEMP @cyphert;
  58.     close C_TEMP;
  59. #    while (<NS>) {
  60. #        print SPIPE "$_";
  61. #    }
  62.  
  63.     print STDERR "$port \n";
  64.     open (SPIPE, "des -dk test $ENV{TMP}/tmp$$ |");
  65.     @clear = <SPIPE>;
  66.     close SPIPE;
  67.     $des_return = $?;
  68.     unlink "$ENV{TMP}/tmp$$" || warn "couldn't unlink cypher_temp $!";
  69.  
  70. #Call back the client and indicate result
  71.  
  72. chop($hostname = `hostname`);
  73.  
  74. ($name,$aliases,$proto) = getprotobyname('tcp');
  75. ($name,$aliases,$port2) = getservbyname($port2,'tcp')
  76.     unless $port2 =~ /^\d+$/;;
  77. ($name,$aliases,$type,$len,$thisaddr)=gethostbyname($hostname);
  78. ($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);
  79.  
  80. $this2 = pack($sockaddr, $AF_INET, 0, $thisaddr2);
  81. $that = pack($sockaddr, $AF_INET, $port2, $thataddr);
  82.  
  83. # Make the socket filehandle.
  84.  
  85. if (socket(S2, $AF_INET, $SOCK_STREAM, $proto)) { 
  86.     print "socket ok\n";
  87. }
  88. else {
  89.     warn $!;
  90. }
  91.  
  92. # Give the socket an address.
  93.  
  94. if (bind(S2, $this2)) {
  95.     print "bind ok\n";
  96. }
  97. else {
  98.     warn $!;
  99. }
  100.  
  101. # Call up the server.
  102.  
  103. if (connect(S2,$that)) {
  104.     print "connect ok\n";
  105. }
  106. else {
  107.     die $!;
  108. }
  109.  
  110. # Set socket to be command buffered.
  111.  
  112. select(S2); $| = 1; select(STDOUT);
  113.  
  114. # Avoid deadlock by forking.
  115.  
  116. #if($child != fork) {
  117.  
  118.  
  119.     if ($des_return==0){
  120.         print S2 "succeeded !!\n";
  121.     }
  122.     else {
  123.         printf S2 "failed \007 \007 %12.8lx !!\n", $des_return;
  124.     }
  125.     close(NS);
  126.     $rslt=0;
  127.     if ($des_return==0){
  128.         eval $line;
  129.            }
  130.     close(S2);
  131.  
  132.  
  133.