#!/usr/bin/perl -w

# $Id: draw_folder.pl,v 1.11 1996/02/14 20:53:38 hoagland Exp $

# draw_folder.pl, by Jim Hoagland (hoagland@cs) 1/96

# this routine generates the message folder display page for the ARPA
# IDS demo GUI 
# its arguments indicates the state, the working set over which to send
# db queries and the folder this is for and outputs HTML to STDOUT using
# server push to redisplay pages when things have changed

require 5.000;

require '/pkg/www/arpa/secret/cgi-bin/gui-helper.pl';
require '/pkg/www/arpa/secret/cgi-bin/network-help.pl';

my(%count,%orecs,@urecs,%new_count,@new_urecs,%latest_folders,$latest_urec);
my(@fconds);
$overall_cond= "(!defined(\$dqy))";

sub init_recs {
  my($state,$folder,@recs)= @_;
  $count{$folder}=@recs;
  my %in_recs=(); # stores whether a record is in some subfolder or not
 
  $new_count{$folder}=0;
  foreach $sub ($state->subfolders($folder)) {
    $new_count{$sub}=0;
    my(@ir)= &recs_in_subfolder($state,$sub,@recs);
    $count{$sub}= @ir;
    grep($in_recs{$_}++,@ir); # record recs inside
  }
 
  @urecs= grep(!$in_recs{$_},@recs); # determine recs outside
  grep($orecs{$_}++,@recs); 
  @new_urecs=();
  %latest_folders= ();
  $latest_urec= '';
}

sub add_rec {
  my($state,$folder,%newrec)= @_;
  my($sub);
  my($newrecref)= \%newrec;

#  print "*add record: ",%newrec,"\n";
  $count{$folder}++;
  $new_count{$folder}++;
  
  %latest_folders= ();
  my($in_sub)=0;
  foreach $sub ($state->subfolders($folder)) {
    if (&in_subfolder($state,$sub,%newrec)) {
#      print "*record ",%newrec,"is in $sub\n";
      $in_sub++;
      $latest_folders{$sub}= 1;
      $count{$sub}++;
      $new_count{$sub}++;
      $latest_urec= "";
    }
  }

  unless ($in_sub) { # not in a subfolder
    push(@new_urecs,$newrecref); 
    $latest_folders{$folder}= 1;
    $latest_urec= $newrecref;
#    print "*record is in $folder",@new_recs,"\n";
  } 
}

sub in_subfolder {
  my($state,$sub,%rec)= @_;
  $cond= $state->folder_condition($sub);
  $cond=~ s/\$(\w+)/\xffrec\{\'$1\'\}/g;
  $cond=~ tr/\xff/\$/;
#  print "Content-type: text/html\n\n** evaling $cond on ",join(',',%rec);
  $ret= eval "($cond)";
#  print " ==> $ret<BR>\n";
  return $ret;
}

sub recs_in_subfolder {
  my($state)= shift;
  my($sub)= shift;
  my(@in)=();
  foreach $recref (@_) {
    push(@in,$recref) if &in_subfolder($state,$sub,%{$recref});
  }
  return @in;
}

sub by_time {$b->{'time'} <=> $a->{'time'};}
sub make_recs_list {
  my($state,$folder)= @_;
  my %tables;
  my $text='';
  foreach $recref (@urecs,@new_urecs) {
    my(%rec)= %{$recref};
    $fldsign= join(';',sort keys %rec);
    $tables{$fldsign}= [] unless defined $tables{$fldsign};
    $tables{$fldsign}= [@{$tables{$fldsign}},$recref];
  }

  foreach $table (sort keys %tables) {
    my(@cols)= split(';',$table);
    # order cols here
    foreach $cond (@fconds) {
      $c= $cond;
      while ($c =~ s/\$(\w+)\s+eq\s+[\'\w]/\xff/) { # exact match test
        @cols= grep($_ ne $1,@cols);
      }
    }

    $text.= "<TABLE BORDER=1>\n";
    $text.= "\t<TH ALIGN=center>";
    foreach $col (@cols) {
      $text.="<TD><STRONG>$col</STRONG></TD>";
    }
    $text.= "</TH>\n";
    foreach $recref (sort by_time @{$tables{$table}}) {
      my(%rec)= %{$recref};
      $text.= "\t<TR ALIGN=center><TD>";
      $text.= '<IMG SRC="images/new.gif">' unless $orecs{$recref};
      $text.= "</TD>";
      foreach $col (@cols) {
	$_= $rec{$col};
	$text.= "<TD>";
	$text.= "<BLINK>" if $latest_urec eq $recref;
	if (m#^\s*(http|file|ftp):/#) { # embedded URL
	    $text.="<A HREF=\"$_\">$_</A>";
	} else {
	  $text.= "$_";
	}
	$text.="</TD>";
	$text.= "</BLINK>" if $latest_urec eq $recref;
      }
      $text.= "</TR>";
      $text.= "\n";
    }
    $text.= "</TABLE>\n";
  }
  return $text;
}

#----

sub make_folder_html {
  my($state,$folder)= @_;
  my($sub,$sup);

  my $sublist= '';
  foreach $sub (sort $state->subfolders($folder)) {
    $sublist.= "<DT>";
    $sublist.= " <A HREF=\"cgi-bin/display_folder.pl?";
    $sublist.= &url_encode("folder=$sub&ws=$ws")."\"><IMG SRC=\"icons/";
    $sublist.= $state->icon($sub)."\"> ";
    $sublist.= $state->folder_tail($sub)." <STRONG>";
    $sublist.= "<BLINK>" if $latest_folders{$sub};
    $sublist.= "$count{$sub} messages ($new_count{$sub} new)";
    $sublist.= "</BLINK>" if $latest_folders{$sub};
    $sublist.= "</STRONG></A> (".$state->folder_condition($sub).")\n";
  }

  my $superlist= '';
  my(@sups)= $state->superfolders($folder);
  pop(@sups);
  foreach $sup (reverse @sups) {
    $superlist.= "<A HREF=\"cgi-bin/display_folder.pl?".&url_encode("folder=$sup&ws=$ws")."\"><IMG SRC=\"icons/".$state->icon($sup)."\"> $sup</A>\n";
  }
  $superlist.= "<A HREF=\"cgi-bin/display_folder.pl?".&url_encode("folder=&ws=$ws")."\"><IMG SRC=\"icons/globe.gif\"> (all)</A>\n";

  &output_instantiated_file('/pkg/www/arpa/secret/gui/html-src/display_folder.html',*STDOUT,
			    '<!!! Insert folder descr here !!!>',($folder?'"'.$folder.'"':'(all)'),
			    '<!!! Insert folder icon path here !!!>',('icons/'.($folder?$state->icon($folder):'globe.gif')),
			    '<!!! Insert WS here !!!>',$ws,
			    '<!!! Insert folder conditions here !!!>',@fconds?join(' <STRONG>and</STRONG> ',@fconds):'(none)',
			    '<!!! Insert Folder Count here !!!>',$count{$folder},
			    '<!!! Insert New Folder Count here !!!>',$new_count{$folder},
			    '<!!! Insert subfolders list !!!>',$sublist,
			    '<!!! Insert superfolders list !!!>',$superlist,
			    '<!!! Insert other messages list !!!>',&make_recs_list($state,$folder,@urecs,@new_urecs),
			    '<!!! Insert Extra URL tail here !!!>',"display_folder_extras.pl?".&url_encode("ws=$ws&folder=$folder"),
			   '<!!! Put date here !!!>',&time_text($time=time)." ($time UTC)");
}

# some code modified from query_db.pl
sub query_db {
  my($state,$ws,$cond)= @_;
  my($reply_port)= &get_responce_port;
  my($db_site);
  my(@countdown_set) = ();
  my(@recs)=();
  my(%mes_count)=();
  my(@dest_hosts)=$state->hosts_in_set($ws);
  return () unless @dest_hosts;

  &setup_bind_udp_socket($reply_port); 
  foreach $db_site (@dest_hosts) {
    &send_db_query ($db_addr= &host2ip($db_site),$reply_port,'perl_expr' => "$cond");
    $site{$db_addr} = $db_site;   # globally available
    push (@countdown_set, $db_site); 
  }

  &show_text_part("Sent message request to ".(join(',',@dest_hosts))."\n");

  #print "Child/query <PID $$> listening on port $reply_port.\n" if $debug;
  while(1) {
    my($from)= recv (QS, $request, $max_length, 0); 
    (undef,undef, $src_addr) = unpack($sockaddr, $from);
    $src_site= $site{$src_addr};
    my(%rec)= &de_scl_msg_format($request);   # SCL FORMAT
    my($res) = join (',', %rec);
    unless (defined $rec{'drep'} && ($rec{'drep'} eq "summary")) {  #DEBUG- DB dependency 
      $mes_count{$src_site}++;
      &show_text_part("Got message $mes_count{$src_site} from $src_site;\nstill waiting on ".(join(',',@countdown_set))."\n") if $mes_count{$src_site} % 100 == 1;
      delete $rec{'qnum'};
      $rec{'dtyp'}= delete $rec{'drep'}; # undo conversion done in audb
      $rec{'from host'}= $src_site;
      push(@recs,\%rec); # ongoing processing
    } else {  # we received final response from one queried source ...
      for ($i = 0; $i <= $#countdown_set; $i++) {
        @countdown_set = (@countdown_set[0..$i-1],
                          @countdown_set[$i+1..$#countdown_set])
	  if $countdown_set[$i] eq $src_site;
      }  # remove this source from our "listening" list
	&show_text_part("Got last message from $src_site;\nstill waiting for ".(join(',',@countdown_set))."\n");
      unless (@countdown_set) {
	&show_text_part("Got all messages; creating display\n");
	return (@recs);
      }
    }
  }
}

sub route_folder_mess_to {
  my($state,$ws,$folder,$port)= @_;
  my $condition='(defined $dtyp || defined $dqy)'; # DEBUG-  assumes only these type of messages appear on audb3
  $condition.= " && $overall_cond";
  foreach ($state->conditions_to_folder($folder)) {
    $condition.= " && ($_)";
  }
  return &route_mess_to($condition,$port,$state->hosts_in_set($ws));
  # return rule to call unroute_mess with
}

#---------

sub draw_folder {
  ($state,$ws,$folder)= @_; 
  @fconds= $state->conditions_to_folder($folder); # global var
  my $fcond= "$overall_cond && ";
  my $fcond= '('.join(') && (',@fconds).')' if @fconds;
  $|=1;

  my ($port)= &setup_logd_pkt_socket(); # sets up PS 
  $rule=&route_folder_mess_to($state,$ws,$folder,$port);
  $SIG{'TERM'}= 'handler';
  $SIG{'INT'}= 'handler';
  $SIG{'PIPE'}= 'handler';
  $SIG{'ALRM'}= 'alarm_handler';

  &start_multipart_output;
  &init_recs($state,$folder,&query_db($state,$ws,$fcond));
  print "Content-type: text/html\nPragma: no-cache\n\n";
  &make_folder_html($state,$folder);
  &end_part;

  while (1) {
    alarm (10);
    $from = recv(PS,$request,$max_length,0); 
    (undef,undef, $src_addr) = unpack($sockaddr, $from);
    %mes= &de_scl_msg_format ($request);
    $src_site= $site{$src_addr};
    $mes{'from host'}= $src_site;
    &add_rec($state,$folder,%mes);
    print "Content-type: text/html\nPragma: no-cache\n\n";
    &make_folder_html($state,$folder);
    &end_part;
  }
}

sub alarm_handler {
  print " ";  # test pipe to client periodically to make sure other
              # end is still alive; if not, SIGPIPE will be generated
              # and handler invoke to clean up
  $SIG{'ALRM'}= 'alarm_handler';
  alarm(30);
}

sub handler {
  # received an signal- cleanup
  &unroute_mess($rule,$state->hosts_in_set($ws));
  exit;
}

1;