#! /usr/bin/perl

# search all the chips and output a list of the ones which
# match the user's search parameters from the fill-out form.

$logfile = '/home/httpd/log/pinouts.log';
$chipdir = '/home/httpd/html/tech/pinouts/chips';
$abort_url = '/tech/pinouts/index.html';
$up_icon = '/img/up.gif';
$datasheet_url = '/cgi-bin/tech/pinouts/datasheet.cgi';
$unknown_chip_icon = '/tech/pinouts/unknown-chip.gif';
$unknown_chip_icon_x = 136;
$unknown_chip_icon_y = 99;
$listfile = 'zzz_chip_list';
$head = "Content-type: text/html\n\n";


if (  $ENV{'HTTP_USER_AGENT'} =~ /Teleport Pro/
   || $ENV{'HTTP_USER_AGENT'} =~ /archiver/
   || $ENV{'HTTP_USER_AGENT'} =~ /^xyro/
   || $ENV{'HTTP_USER_AGENT'} =~ /WebZIP/
   || $ENV{'HTTP_USER_AGENT'} eq 'Mozilla'
   || $ENV{'HTTP_USER_AGENT'} eq 'Mozilla/4.0'
   || $ENV{'HTTP_USER_AGENT'} =~ /WebReaper/
   || $ENV{'HTTP_USER_AGENT'} =~ /WebCopier/
   || $ENV{'HTTP_USER_AGENT'} =~ /WebSymmetrix/
   || $ENV{'HTTP_USER_AGENT'} =~ /Offline Explorer/
   || $ENV{'HTTP_USER_AGENT'} =~ /HTTrack/
   || $ENV{'HTTP_USER_AGENT'} =~ /Wget/) {
	print $head;
	print "Please do not archive this pinout index with\n";
	print "Teleport Pro, or similar archiving programs\n";
	print "It consumes our limited and expensive bandwidth\n";
	print "that we pay for every month, out of our own\n";
	print "pockets, to bring this web site to you... for free!\n";
	exit 0;
}

$ref = $ENV{'HTTP_REFERER'};
$ref = "ECE" if $ref =~  /^http:\/\/www\.ece\.orst\.edu/;
$ref = "PJRC" if $ref =~  /^http:\/\/www\.pjrc\.com/;
$ref = "PJRC" if $ref =~  /^http:\/\/pjrc\.com/;

open(LOG, ">>$logfile");
print LOG "pid:$$, time:$^T, method:$ENV{'REQUEST_METHOD'}, query:$ENV{'QUERY_STRING'}\n";
print LOG "pid:$$, host:$ENV{'REMOTE_ADDR'}, ref:$ref\n";
close(LOG);


#get fill-out for search keys, if any

$do_search=$do_n1=$do_d1=$do_n2=$do_d2=$do_n3=$do_d3=0;
if (&ReadParse(*in)) {
	$skey1 = $1 if $in{'key1'} =~ /([-_A-Za-z0-9]+)/;
	$skey2 = $1 if $in{'key2'} =~ /([-_A-Za-z0-9]+)/;
	$skey3 = $1 if $in{'key3'} =~ /([-_A-Za-z0-9]+)/;
	$in{'type1'} = 'both' if (!defined($in{'type1'}));
	$in{'type2'} = 'both' if (!defined($in{'type2'}));
	$in{'type3'} = 'both' if (!defined($in{'type3'}));
	$do_n1 = 1 if ($in{'type1'} eq 'both' || $in{'type1'} eq 'name');
	$do_d1 = 1 if ($in{'type1'} eq 'both' || $in{'type1'} eq 'desc');
	$do_n2 = 1 if ($in{'type2'} eq 'both' || $in{'type2'} eq 'name');
	$do_d2 = 1 if ($in{'type2'} eq 'both' || $in{'type2'} eq 'desc');
	$do_n3 = 1 if ($in{'type3'} eq 'both' || $in{'type3'} eq 'name');
	$do_d3 = 1 if ($in{'type3'} eq 'both' || $in{'type3'} eq 'desc');
	$do_search = 1 if length($skey1) || length($skey2) || length($skey3);
}

# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #1 - input args parsed and cleaned\n";
# close(LOG);


chdir($chipdir) || die "$head Cannot change directory to $chipdir\n";

#read in file with chip descriptions
open (CF, $listfile);
while (<CF>){
   	/^([^:]+):(.*)\n$/;
	$list{$1} = $2;
}
close(CF);

# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #2 - read all descriptions from file\n";
# close(LOG);

#read the directory and parse any chips not listed in the file
$countem = $countnew = 0;
opendir(CDIR, $chipdir) || die "$head Cannot open directory $chipdir\n";
while ( $_ = $name = readdir(CDIR) ){
	if ( /^(.*)\.chipspec$/ ){
		next if (defined($list{$1}));
		$countem++;
		open (IN, $name);
		$name =~ s/\.chipspec$//;
		$list{$name} = "";
		while (<IN>) {
			if (/^DESC:/) {
				chop;
				$list{$name} = $_;
				$list{$name} =~ s/^DESC:\s//;
				$list{$name} = $list{$name};
				$countnew++;
				$lastnew = $name . ':' . $list{$name};
			}
		}
		close(IN);
	}
}
closedir(CDIR);

# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #3 - new chip search complete\n";
# close(LOG);

#now search for all the chips that we will print
$isk1 = length($skey1);
$isk2 = length($skey2);
$isk3 = length($skey3);
$assign = '$out_list{$key} = $list{$key}';
$search_prog_or = <<EOF_OR;
foreach \$key (keys \%list) {
	if ($do_search) {
		\$_ = \$key;
		$assign if ($isk1 && $do_n1 && /$skey1/i);
                $assign if ($isk2 && $do_n2 && /$skey2/i);
                $assign if ($isk3 && $do_n3 && /$skey3/i);
		\$_ = \$list{\$key};
		$assign if ($isk1 && $do_d1 && /$skey1/i);
		$assign if ($isk2 && $do_d2 && /$skey2/i);
		$assign if ($isk3 && $do_d3 && /$skey3/i);
	} else {
		$assign;
	}
}
EOF_OR

$search_prog_and = <<EOF_AND;
foreach \$key (keys \%list) {
        if ($do_search) {
                $assign if (($do_n1 && \$key =~ /$skey1/i) || \!($isk1) ||
		  ($do_d1 && \$list{\$key} =~ /$skey1/i)) &&
                  (($do_n2 && \$key =~ /$skey2/i) || \!($isk2) ||
		  ($do_d2 && \$list{\$key} =~ /$skey2/i)) &&
                  (($do_n3 && \$key =~ /$skey3/i) || \!($isk3) ||
		  ($do_d3 && \$list{\$key} =~ /$skey3/i));
        } else {
                $assign;
        }
}
EOF_AND

if ($in{'logic'} eq 'or') {
	$search_prog = $search_prog_or;
} else {
	$search_prog = $search_prog_and;
}
# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #4 - custom search code created\n";
# close(LOG);

eval $search_prog;
print "$head error within eval: $@" if $@;
exit if $@;

# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #5 - search completed\n";
# close(LOG);


vec($win, fileno(STDOUT), 1) = 1;

#output the html
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "Content-type: text/html\n\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<a href=\"$abort_url\">";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<img align=right src=\"$up_icon\" height=37 width=34></a>\n";

&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<h2><img src=\"$unknown_chip_icon\" alt=\"I.C.\"";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print " width=$unknown_chip_icon_x height=$unknown_chip_icon_y";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print " align=middle>Paul's IC Pinout Index</h2>\n";

&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<br clear=all>\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<h3>All Available Chips</h3>\n\n" unless $do_search;
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<h3>Matching Chips</h3>\n\n" if $do_search;

##for checking that the generated search code is ok...
##print "<h3>Search Code</h3>", '<pre>', $search_prog, '</pre>' if ($do_search);

foreach $key (sort keys %out_list){
	&timeout if (select(undef, $wout=$win, undef, 90) == 0);
	print "<a href=\"$datasheet_url?$key\">$key</a>";
	&timeout if (select(undef, $wout=$win, undef, 90) == 0);
	print " - $out_list{$key}" if ($out_list{$key});
	&timeout if (select(undef, $wout=$win, undef, 90) == 0);
	print "<br>\n";
}

#this stuff for troubleshooting
#print "<p>$countem files parsed!\n";
#print "<p>$countnew new descriptions found\n";

&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<hr size=3>\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "Paul's Experimental IC Pinout Index, Paul Stoffregen\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<br>http://www.ece.orst.edu/~paul/pinouts/complex-search.html\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<br>Status: experimental cgi project.\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<br>Suggestions, comments??\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<a href=\"mailto:paul\@ece.orst.edu\">&lt;paul\@ece.orst.edu&gt;</a>\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<hr size=3>\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<a href=\"$abort_url\">\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "<img align=middle src=\"$up_icon\" height=37 width=34>\n";
&timeout if (select(undef, $wout=$win, undef, 90) == 0);
print "Return to pinout index top page</a>\n";

# open(LOG, ">>$logfile");
# print LOG "pid:$$, ok at test point #6 - html done, cleaning up...\n";
# close(LOG);


#and if we found any new descriptions, write a new desc file.
if ($countnew) {
	open (CF,">$listfile");
	foreach $key (keys %list) {
		print CF "$key:$list{$key}\n" if (length($list{$key}));
	}
}

open(LOG, ">>$logfile");
print LOG "pid:$$, terminated properly\n";
close(LOG);

exit(0);


#from cgi-lib.pl, Copyright 1994 Steven E. Brenner (S.E.Brenner@bioc.cam.ac.uk)
sub ReadParse {
  local (*in) = @_ if @_;
  local ($i, $key, $val);

  if ($ENV{'REQUEST_METHOD'} eq 'GET') {
    $in = $ENV{'QUERY_STRING'};
  } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }
  @in = split(/&/,$in);
  foreach $i (0 .. $#in) {
    $in[$i] =~ s/\+/ /g;
    ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
    $key =~ s/%(..)/pack("c",hex($1))/ge;
    $val =~ s/%(..)/pack("c",hex($1))/ge;
    $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
    $in{$key} .= $val;
  }
  return length($in);
}

sub timeout {
	open(LOG, ">>$logfile");
	print LOG "pid:$$, terminated w/ error - timeout sending html output\n";
	close(LOG);
	# I tried using exit and die here, and they seem to make the
	# script stop, but they don't make the process go away!
	kill 'TERM', $$;
	sleep 5;
	kill 'KILL', $$;
	sleep 5;
	open(LOG, ">>$logfile");
        print LOG "pid:$$, ERROR ERROR ERROR - we couldn't terminate!!!\n";
        close(LOG);
}