File indexing completed on 2025-01-19 06:55:04
0001 #!/usr/bin/perl 0002 0003 use Fcntl; 0004 use Socket; 0005 0006 # Port to listen on - if you have multiple scripts, each must listen on 0007 # different port number. Also, port numbers must be in range 1024-65535. 0008 my $port = 2400; 0009 0010 sub handleText 0011 { 0012 my $line = $_[0]; 0013 # handle incoming text here 0014 0015 } 0016 0017 sub handleInput 0018 { 0019 my $line = $_[0]; 0020 # handle user's commands here 0021 0022 } 0023 0024 sub parsePrompt 0025 { 0026 my $line = $_[0]; 0027 # handle prompt here 0028 0029 } 0030 0031 sub handleNotify 0032 { 0033 my $line = $_[0]; 0034 # handle notify requests here 0035 0036 } 0037 0038 sub fhbits 0039 { 0040 my(@fhlist) = split(' ', $_[0]); 0041 my($bits); 0042 for (@fhlist) { 0043 vec ($bits, fileno ($_), 1) = 1; 0044 } 0045 $bits; 0046 } 0047 0048 sub notifyPrepare 0049 { 0050 # most of this comes from tmpserver.pl 0051 if (getservbyport (port,"tcp")) 0052 { 0053 die ("Port already in use\n"); 0054 } 0055 0056 my $prototype = getprotobyname ("tcp"); 0057 0058 socket(SERV_SOCKET, PF_INET, SOCK_STREAM, $prototype) 0059 or die("Socket creation failure\n"); 0060 0061 setsockopt(SERV_SOCKET, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)) 0062 or die ("Failure in setsockopt(): $!"); 0063 0064 bind(SERV_SOCKET, sockaddr_in($port, INADDR_ANY)) 0065 or die ("Cannot bind socket\n"); 0066 0067 listen (SERV_SOCKET, 1) 0068 or die ("Cannot listen on socket\n"); 0069 0070 $notifyOpen = 0; 0071 } 0072 0073 $| = 1; 0074 0075 $flags = fcntl (STDIN, F_GETFL, 0); 0076 fcntl (STDIN, F_SETFL, $flags | O_NONBLOCK) 0077 or die "Cannot set non-blocking mode\n"; 0078 0079 # prepare the socket for notify 0080 notifyPrepare (); 0081 0082 while (1) 0083 { 0084 my $rin = fhbits ('STDIN SERV_SOCKET NOTIFY'); 0085 my $nfound = select ($bits=$rin, undef, undef, undef); 0086 0087 if (vec ($bits, fileno (STDIN), 1) == 1) 0088 { 0089 while ($rd = <STDIN>) 0090 { 0091 $type = substr ($rd, 0, 1); 0092 $text = substr ($rd, 2, length($rd) - 2); 0093 if (int ($text[length ($text) - 1]) < 32) 0094 { 0095 $text = substr ($text, 0, length($text) - 1); 0096 } 0097 0098 if ($type eq "1") 0099 { 0100 handleText ($text); 0101 } 0102 elsif ($type eq "2") 0103 { 0104 handleInput ($text); 0105 } 0106 elsif ($type eq "3") 0107 { 0108 parsePrompt ($text); 0109 } 0110 } 0111 } 0112 if (vec ($bits, fileno (SERV_SOCKET), 1) == 1) 0113 { 0114 accept (NOTIFY, SERV_SOCKET); 0115 $notifyOpen = 1; 0116 $flags = fcntl (NOTIFY, F_GETFL, 0); 0117 fcntl (NOTIFY, F_SETFL, $flags | O_NONBLOCK) 0118 or die "Cannot set non-blocking mode\n"; 0119 } 0120 if ($notifyOpen and (vec ($bits, fileno (NOTIFY), 1) == 1)) 0121 { 0122 # read from socket 0123 while ($rd = <NOTIFY>) { 0124 # strip trailing newline 0125 if (int ($rd[length ($rd) - 1]) < 32) 0126 { 0127 $rd = substr ($rd, 0, length($rd) - 1); 0128 } 0129 handleNotify ($rd); 0130 } 0131 } 0132 0133 } 0134 0135 close (NOTIFY); 0136 close (SERV_SOCKET); 0137 0138