#!/usr/local/bin/perl
BEGIN {
    require 'wwwlib.pl';
    require 'italk2html.pl';
}
&tcp::init;

$| = 1;
if ($ENV{CGI_TEST}) {
    $ENTRY="HOST=main&DAYSEL=1&DAY1=0&DAY2=19981001&TYPE=FIXED";
} else {
    if ($ENV{REQUEST_METHOD} ne 'POST') {
	print &http_header(status => 302, location => 'italklog.html');
	exit 0;
    }
    $ENTRY = &read_cgi_post_args(STDIN);
}
%ARGS = &parse_cgi_arguments($ENTRY);

if ($ARGS{HOST} eq 'main') {
    $target = "main.italk.ne.jp";
    $url = "/12345/%Y%m%D.italk";
} elsif ($ARGS{HOST} eq 'sub') {
    $target = "www.st.rim.or.jp";
    $url = "/~mina/italk_log/%Y%m%D.italk";
} else {
    goto error;
}

if ($ARGS{DAYSEL} eq '1') {
    $days = $ARGS{DAY1};
    if ($days !~ /^[0-9]?[0-9]$/) {
	goto error;
    }
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
      = localtime(time - 60*60*24* $days);
    $days = sprintf("%04d%02d%02d", $year + 1900, $mon + 1, $mday);
} elsif ($ARGS{DAYSEL} eq '2') {
    $days = $ARGS{DAY2};
    if ($days !~ /^\d{8}$/) {
	goto error;
    }
} else {
    goto error;
}

if ($ARGS{TYPE} eq 'FIXED') {
    $fixed_width = 1;
} elsif ($ARGS{TYPE} eq 'VARIABLE') {
    $fixed_width = 0;
} elsif ($ARGS{TYPE} eq 'RAWLOG') {
    $rawlog = 1;
} else {
    $rawlog = 1;
}

$variable_width = 1 - $fixedwidth;

$url =~ s/\%Y\%m\%D/$days/;

if ($rawlog) {
    print &http_header(status => 302, location => "http://$target$url");
    exit 0;
}

print &http_header;
print "<HTML><HEAD><TITLE>Italk Log ($target$url)</TITLE></HEAD><BODY BGCOLOR=\"White\">\r\n";

eval {
    &connect_socket (*S, $target, 80);
};
goto connecterror if $@;

print S "GET $url HTTP/1.0\r\nHost: $target\r\nUser-Agent: italklog.cgi/2.0\r\n\r\n";

$statline = <S>;
$header = read_http_header (*S);
if (!$statline) {
    goto connecterror;
}
if ($statline !~ /^HTTP\/1\.\d+ 200/) {
    print while <S>;
    exit 0;
}

print "<PRE>" if ($fixed_width);
italk2html::init ( facett => $variable_width, timetag => 1, 
                   systemtt => $variable_width, 
                   spencode => $variable_width,
                   suppress_br => $fixed_width,
                   target => '_new');

while(<S>) {
    print italk2html::conv($_);
}
print "</PRE>" if ($fixed_width);
close(S);
print "</BODY></HTML>";
exit 0;

connecterror:
print "<FONT COLOR=RED>接続に失敗しました。</FONT>\r\n";

error:
print &http_header;

print "<FONT COLOR=RED>入力が不正です。</FONT>\r\n";
exit 1;

#--------------------- tcp.pl begins ------------------
#!/usr/local/bin/perl
#
# tcp.pl : Easy TCP Socket Library
#
# This Package Provides:
#
# &connect_socket(Handle *Socket, String host, Int Port,
#                 optional String Situation);
# &set_timeout(Int seconds);
#
# $Id: tcp.pl,v 1.5 1997/12/29 15:25:41 yutaka Exp $
#

###  connect_socket : make a connection with TCP socket.
 
package tcp;

sub init {
    return if $inited;
    $inited = 1;

# customize values
# if perl is improperly installed, search these values
# from C include file and put it here. values here is
# BSD default.

#   $SOCK_STREAM = 1;
#   $AF_INET = 2;

    &alephlib'init;

    $IsWin32 = $main'IsWin32; #'
    $IsPerl5 = $main'IsPerl5; #'
    $Flag_alarm = ! $IsWin32;
    $timeout = 120;
}

sub set_timeout {
    $timeout = @_;
}

sub main'connect_socket { #'
    local(*SOCKET, $host, $port, $situation) = @_;
    local($name, $aliases, $proto, $aliases, $type, $len, $thataddr);
    local($thataddr, $that);
    local(%SIG, $mes);

    if (defined $situation) {
	$mes = " $situation:";
    } else {
	$mes = "";
    }

    # detect AF_INET value

    if (! defined $AF_INET || ! defined $SOCK_STREAM) {
	if ($IsPerl5) {
	    eval "use Socket";	# Perl5
	} else {
	    eval "require 'sys/socket.ph'";   # Perl4
	}
	die $@ if ($@);
	$AF_INET = &AF_INET;
	$SOCK_STREAM = &SOCK_STREAM;
    }

    ($name, $aliases, $proto) = getprotobyname('tcp');
    ($name, $aliases, $port) = getservbyname($port, 'tcp')
	unless $port =~ /^\d+$/;

    if($host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
	$thataddr = pack('c4', $1, $2, $3, $4);
    } else {
	eval {
	    $SIG{'ALRM'} = "tcp'timed_out" if ($Flag_alarm); #'
	    &set_alarm($timeout);

	    ($name, $aliases, $type, $len, $thataddr) =  gethostbyname($host);

	    &set_alarm(0);
	};

	if ($@) {
	    die "connect_socket:$mes address resolver time out.";
	}
    }

    if (! $thataddr) {
	die "connect_socket:$mes Unknown host: $host.";
    }

    $that = pack('S n a4 x8', $AF_INET, $port, $thataddr);

    if (! socket(SOCKET, $AF_INET, $SOCK_STREAM, $proto)) {
	die "socket:$mes $!.";
    }

    $Message = '';

    eval {
	
	$SIG{'ALRM'} = 'timed_out' if ($Flag_alarm);
	&set_alarm($timeout);

	if (! connect(SOCKET, $that)) {
	    &set_alarm(0);
	    $Message = "connect:$mes $!.";
	}
	&set_alarm(0);
    };

    if ($@) {
	$Message = "connect_socket:$mes connection timed out.";
    }
    if ($Message) {
	close (SOCKET);
	die $Message;
    }

    select(SOCKET); $| = 1; binmode(SOCKET); select(STDOUT);

    return 1;
}

sub timed_out {
    die "";
}

sub set_alarm {
    alarm($_[0]) if ($Flag_alarm);
}

&init;
1;

package main;
exit 0; # ----------- end of tcp.pl ------------------

#--------------------- alephlib.pl begins ------------------
######################################################################
#
# Aleph's Library: Some Common Perl Routine
#
######################################################################

# this package provides:
#  $HomeDirectory
#  $IsWin32
#  $IsPerl5
#  $CommandName
#  $PerlSpec
#  $OSType

# $Id: alephlib.pl,v 1.7 1997/12/29 17:55:30 yutaka Exp $

package alephlib;

sub init {
    return if $inited;
    $inited = 1;

    &detect_environment;
    $ScriptName = &get_command_name;
    $HomeDirectory = &get_user_vicinity;

    # export value
    $main'HomeDirectory = $alephlib'HomeDirectory;
    $main'ScriptName = $alephlib'ScriptName;
    $main'IsWin32 = $alephlib'IsWin32;
    $main'IsPerl5 = $alephlib'IsPerl5;
    $main'BuggyIO = $alephlib'BuggyIO;
    $main'OSType = $alephlib'OSType; 
    $main'POSIX_times_avail = $alephlib'POSIX_times_avail;
    $main'POSIX_timetick = $alephlib'POSIX_timetick;
    $main'PerlSpec = $alephlib'PerlSpec;
}

sub yesno {
    $_[0] ? "yes" : "no";
}

sub diagnostics {
    printf "
Alephlib Diagnostics:
  Is This Perl Version5? : %s
  Is This Perl Win32's?  : %s
  OS Type                : %s
  POSIX times() Avail?   : %s (tick=%d)
  Script name            : %s
  Home Directory         : %s
  Perl Spec String       : %s
", &yesno($IsPerl5), &yesno($IsWin32), $OSType, &yesno($POSIX_times_avail),
    $POSIX_timetick, $ScriptName, $HomeDirectory, $PerlSpec;
}

sub get_command_name {
    local($_) = $0;

    s|^..*/||o;
    s|\.[a-z]+$||io;		# extension .pl (.bat in Win32)
    y/A-Z/a-z/;
    
    $_;
}

sub get_user_vicinity {
    if ($IsWin32) {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} || $ENV{'windir'};
	s/\\/\//g;
    } else {
	$_ = $ENV{'HOME'} || $ENV{'LOGDIR'} ||
	    (getpwuid($<))[7];
    }
    $_ || die "$ScriptName: Can't find Home Directory!\n";
}

sub detect_environment {
    local ($@); # Error Trap is Local
    local ($string, $major, $minor, $build, $id, $specstr);
    local ($osname, $nodename, $release, $reldate, $domainname);
    $IsWin32 = 0; #'

    eval q|$_ = &Win32'GetCwd;|;	#'
    $IsWin32 = 1 if (!($@)); 

    $PerlVersion = sprintf ("%g", $] + 0);
    $IsPerl5 = ($PerlVersion > 5.0); 

    # perl 4.036 (at least on Linux) has problem when mixing read() and <>.
    $BuggyIO = ! $IsPerl5;
    $POSIX_times_avail = 0;
    $POSIX_timetick = 1;
    if ($IsWin32) {
	# Win32 environ detection
	# I think all "Perl for Win32" are Perl5,
	# but take care.
	eval q|
	    ($string, $major, $minor, $build, $id) = &Win32'GetOSVersion; #'
	|;
	$OSType = ('Win+Win32S', 'Win95', 'WinNT')[$id];
	if ($string eq '') {
	    $OSType = sprintf("%s %d.%02d", $OSType, $major, $minor);
	} else {
	    $string =~ s/\b(\S+)\b +/\u$1/g;
	    $OSType = sprintf("%s %d.%02d-%s", $OSType, $major, $minor, $string);
	}
	if ($@) {
	    $OSType = "Win-Unknown";
	}
	$PerlSpec = "Perl $PerlVersion-Win32, " . &Win32'PerlVersion . #'
	    ", $OSType";
    } else {
	if ($IsPerl5) {
	    eval '
		use POSIX; 
		($osname, $nodename, $release, $reldate, $domainname)
		    = &POSIX::uname;
		$OSType = ucfirst("$osname $release");
                eval {
                  $POSIX_timetick = &POSIX::sysconf(&POSIX::_SC_CLK_TCK);
                  if ((POSIX::times())[0] < 1) { # SunOS4 returns 0 for times(2)
                    $POSIX_timetick = 1;
                  } else {
                    $POSIX_times_avail = 1;
                  }
                };
                $@ = "";
	    ';
	    if ($@ ne '') {
		eval '
		    use Config; 
		    $OSType = ucfirst($Config{"osname"});
		';
		if ($@) {
		    $OSType = $ENV{'OSTYPE'} || 'Unix';
		    $OSType = "\u$OSType";
		}
	    }
	} else {
	    $OSType = $ENV{'OSTYPE'} || 'Unix';
	    $OSType = "\u$OSType";
	}
	$PerlSpec = "Perl $PerlVersion, $OSType";
    }
}

&init;
1;

package main;
exit 0; # ----------- end of alephlib.pl ------------------

