home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / sockperl.zip / eval_cry.pl < prev    next >
Text File  |  1995-03-23  |  3KB  |  137 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. sleep 2;
  104. if (connect(S2,$that)) {
  105.     print "connect ok\n";
  106. }
  107. else {
  108.     warn $!;
  109. }
  110.  
  111. # Set socket to be command buffered.
  112.  
  113. select(S2); $| = 1; select(STDOUT);
  114.  
  115.  
  116.     if ($des_return==0){
  117.         print S2 "succeeded !!\n";
  118.     }
  119.     else {
  120.         printf S2 "failed \007 \007 %12.8lx !!\n", $des_return;
  121.     }
  122.     close(NS);
  123.     $rslt=0;
  124.     if ($des_return==0){
  125.         foreach $line(@clear){
  126.               eval $line;
  127.         }
  128.        }
  129.     close(S2);
  130.     exit;
  131.     }
  132.     close (NS);
  133.     printf("Listening for connection %d\n",$con+1);
  134.  
  135. }
  136.  
  137.