#!/usr/local/bin/perl use Socket; my $HOST = 'irc.kyoto.wide.ad.jp:6667'; my $PRXMODE = 0; my $PRXHOST = ''; my $NICK = 'lobox29'; my $USER = 'lobox'; my $PASS = ''; my $CHAN = '#test'; my $SCRIPT = 'webirc.cgi'; my $CRLF = "\x0d\x0a"; my $DEBUG = 1; my $MODE = 0; my $SEND_FILE = 'C:\ircsend.txt'; my $RECV_FILE = 'C:\ircrecv.txt'; $| = 1; if($ARGV[0] eq 'log'){ socket(SOCK,AF_INET,SOCK_STREAM,getprotobyname('tcp')) || die; select((select(SOCK),$|=1)[0]); if($PRXMODE > 0){ $PRXHOST =~m|([\w.-]+):(\d+)|; connect(SOCK,sockaddr_in($2,inet_aton($1))) || die; if($PRXMODE == 1){ print SOCK ((my $REQ = <){ last if m|^\x0d?\x0a$|; } }elsif($PRXMODE == 3){ $HOST =~m|^([\w.-]+):(\d+)|; print SOCKET pack "C2nA4x",4,1,$2,inet_aton($1); die if !~m|^[\x00\x04\x30]\x5a|; }elsif($PRXMODE == 4){ $HOST =~m|^([\w.-]+):(\d+)|; print SOCK pack "CCx",5,1; die if !~m|^\x05|; print SOCK pack "C2xCA4n",5,1,1,inet_aton($1),$2; die if !~m|^\x05\x00|; } }else{ $HOST =~m|([^:]+):(\d+)|; print "$1:$2\n"; connect(SOCK,sockaddr_in($2,inet_aton($1))) || die; } print SOCK "PASS $PASS$CRLF"; print SOCK "USER $USER localhost 127.0.0.1 :$USER$CRLF"; print SOCK "NICK $NICK$CRLF"; print SOCK "MODE $NICK +i$CRLF"; print SOCK "JOIN $CHAN$CRLF"; $|=1; my $boundary = "---ThisIsRandomString---"; print "HTTP/1.0 200 OK\n"; print "Content-type: multipart/x-mixed-replace;"; print "boundary=$boundary\n\n"; print "$boundary\n"; my $rs = -s $RECV_FILE; my $ss = -s $SEND_FILE; my($rin,$rout); while(1){ vec($rin,fileno(SOCK),1) = 1; if(select($rout=$rin,undef,undef,1)){ open FH,">>$RECV_FILE"; my $line = ; if($line =~m|^PING (.*)|){ print SOCK "PONG $1$CRLF"; } print FH $line; close FH; }elsif($ss != -s $SEND_FILE){ open FH,$SEND_FILE; while(){ $line = $_; } print SOCK "$line$CRLF"; close FH; $ss = -s $SEND_FILE; }elsif($rs != -s $RECV_FILE){ open FH,$RECV_FILE; my $i=0; while(){ $i++; } my $m=$i; seek FH,0,0; $i=0; print "Content-type: text/plain\n\n"; while(){ print if $i++ + 10 > $m; } close FH; $rs = -s $RECV_FILE; print "$boundary\n"; } } }elsif($ARGV[0] eq 'form'){ my(%FORM,$buffer,$k,$v); if($ENV{REQUEST_METHOD} eq 'POST'){ read STDIN,$buffer,$ENV{CONTENT_LENGTH}; for(split '&',$buffer){ if(($k,$v) = m|^([^=]+)=(.*)$|){ $v =~tr|+| |; $v = unescape(\$v); $FORM{$k} = $v; } } } if($FORM{m} ne ''){ open FH,">>$SEND_FILE"; print FH "PRIVMSG $CHAN $FORM{m}$CRLF"; close FH; open FH,">>$RECV_FILE"; print FH "PRIVMSG $CHAN $FORM{m}$CRLF"; close FH; } print "Content-type: text/html\n\n"; print <
HTML exit; }else{ print "Content-type; text/html\n\n"; print < HTML } #URI unescape sub unescape{ my $str = ${$_[0]}; $str =~s|%([a-f\d]{2})|pack 'H2',$1|ieg; $str; }