#!/usr/bin/perl

# example use of sellib.pl with both TCP and SSL.

require "sellib.pl";

#################### GETROOT ###################

### global per-client states ###
# these need to be delete()'d in the clientpurge routine, hash keys don't use reference counting. #

# hash on id
my %rootwinstate;

### end global per-client states ###

### initialize ###

$sellib::protocols{8080} = {
  "parse" => \&clientparserootwin,   # what to do to process input                    (id,one line of data)
  "open"  => \&clientopenrootwin,    # what to do when peer opens the connection      (id)
  "close" => \&clientcloserootwin,   # what to do when peer closes the connection     (id)
  "purge" => \&clientpurgerootwin,   # hash key deletion on ids for memory management (id)
  "split" => \&clientsplitrootwin,   # what to split the lines of data on             (id)
  "idle"  => \&serveridlerootwin,    # what to do every $timeout seconds              (port)
  "type"  => "SSL",                  # "SSL" or plain "TCP"
  "stop"  => \&serverstoprootwin,    # what to do when the server shuts down          (port)
  "start" => \&serverstartrootwin,   # what to do when the server starts up           (port)
};
$sellib::protocols{8081} = {
  "parse" => \&clientparserootwin,   # what to do to process input                    (id,one line of data)
  "open"  => \&clientopenrootwin,    # what to do when peer opens the connection      (id)
  "close" => \&clientcloserootwin,   # what to do when peer closes the connection     (id)
  "purge" => \&clientpurgerootwin,   # hash key deletion on ids for memory management (id)
  "split" => \&clientsplitrootwin,   # what to split the lines of data on             (id)
  "idle"  => \&serveridlerootwin,    # what to do every $timeout seconds              (port)
  "type"  => "TCP",                  # "SSL" or plain "TCP"
  "stop"  => \&serverstoprootwin,    # what to do when the server shuts down          (port)
  "start" => \&serverstartrootwin,   # what to do when the server starts up           (port)
};

### end initialize ###

sub serverstartrootwin {  # {start}
  my $port = shift;
  &sellib::debugprint("${port}-I==Server Starting\n");
}

sub serverstoprootwin {   # {stop}
  my $port = shift;
  &sellib::debugprint("${port}-I==Server Stopping\n");
}

sub serveridlerootwin {   # {idle}
  my $port = shift;
  &sellib::debugprint("${port}-I==IDLE MARK (" . time() . ")\n");
  
}

sub clientsplitrootwin {  # {split}
  my $id = shift;
  return '\n';

}

sub clientparserootwin {  # {parse}
  my $id = shift;
  my $data = shift;
  my $size = '';
  my $wid = '';
  my $type = 'png';
  my $url = '';
  my $query = '';
  my $mime = 'image/png';
  if ($rootwinstate{$id} == 0) {
    if ($data =~ /^GET \/avatar/) { $size = "avatar"; }
    if ($data =~ /^GET \/avatar60/) { $size = "avatar60"; }
    if ($data =~ /^GET \/avatar65/) { $size = "avatar65"; }
    if ($data =~ /^GET \/avatar48w/) { $size = "avatar48w"; }
    if ($data =~ /^GET \/avatar60w/) { $size = "avatar60w"; }
    if ($data =~ /(?:\.jpg|\.jpeg)/) { $type = "jpeg"; $mime = "image/jpeg"; }
#    if ($data =~ /(?:\.jp2|\.jpeg2)/) { $type = "jp2"; $mime = "image/jp2"; }
    if ($data =~ /(?:\.tif|\.tiff)/) { $type = "tiff:/tmp/tiff$id.tiff ; cat /tmp/tiff$id.tiff; rm /tmp/tiff$id.tiff \#"; $mime = "image/tiff"; }
    if ($data =~ /\.bmp/) { $type = "bmp"; $mime = "image/bmp"; }
    if ($data =~ /\.gif/) { $type = "gif"; $mime = "image/gif"; }
    if ($data =~ /\.ps/) { $type = "ps"; $mime = "application/ps"; }
    if ($data =~ /\.pdf/) { $type = "-rotate 270 ps:/dev/stdout | ps2pdf - \#"; $mime = "application/pdf"; }
    if ($data =~ /^GET \/small/) { $size = "small"; }
    if ($data =~ /^GET \/(?:small|)(0x[0-9a-fA-F]+)/) { $wid = $1; }
    if ($data =~ /^GET \/(?:small|avatar|avatar60w?|avatar48w|avatar65|)(root)/) { $wid = 'root'; }
    if ($data =~ /^GET ([^\? \#]*)\??([^ \#]*)/) { $url = $1; $query = $2; }
    my $gr = '';
    if ($wid eq '' and $size eq '') {
      $mime = 'text/html';
      if ($url eq "/") {
        $gr = &rootwindohtml;
      } elsif ($url eq "/sel.pl") {
        $mime = 'text/plain';
        $gr = `cat /root/.sethenv/bin/sel.pl`;
      } else {
        $mime = 'text/plain';
        $gr = "You are looking for $url, with a query of $query.\n";
      }
    } else {
      &sellib::debugprint("$clhashport{$id}-$id==SCREENSHOT NOT TAKEN\n");
    }

    my $resp = "HTTP/1.0 200 OK\r\nServer: rootwin/1.1 (Perl)\r\nConnection: close\r\nContent-length: %l\r\nContent-type: %t\r\nRefresh: 60\r\n\r\n";

    $resp =~ s/%t/$mime/g;
    $resp =~ s/%l/length($gr)/e;
    $rootwinstate{$id} = 1;
    &sellib::senddata($id,$resp . $gr);
    &sellib::disconnect($id,1);
  } 
}

sub clientopenrootwin {   # {open}
  $rootwinstate{shift()} = 0;
}

sub clientcloserootwin {  # {close}
  $rootwinstate{shift()} = 2;
}

sub clientpurgerootwin {  # {purge}
  delete $rootwinstate{shift()};
}

### library functions ###

sub rootwindohtml {
  my $html = '<html>
  <head>
    <title>Rootwin Perl Multi-Protocol Server</title>
  </head>
  <body>
    <h1>Rootwin Perl Multi-Protocol Server</h1>
    <p>This server used to send a current screenshot of the root window of this workstation\'s X display :0.</p>
    <p></p>
  </body>
</html>';
  #my $h = `xlsclients -display :0 -l | perl -pe 's/^W/\007W/gs' | egrep 'Window|Command' | perl -pe 's/\n//gs;s/\007/\n/gs' | cut -d' ' -f 2- | cut -d: -f 1,3-`;
  #$h =~ s,(0x[0-9a-fA-F]+):  (.*?)\n,<dt><a href="/$1"><img src="/small$1" /></a></dt><dd><code>$2</code></dd>,gs;
  #$h =~ s/\n/<br \/>/gs;
  #$html =~ s/%h/$h/g;
  return $html;
}

### end library functions ###

################## END GETROOT #################

##################### START ####################

sellib::start_listening();
sellib::main_loop();

###################### END #####################