#!/usr/bin/perl

$XMESSAGE = "xmessage";

use POSIX ":sys_wait_h";
use LWP::UserAgent;
use File::Temp qw(tempdir);
use IO::Handle;

# 1. init

our $TEMPDIR;

our $check_ms = 300;
our $on_exit_only = 0;
our $dirty_wait = 1;
our $quiet = 0;

BEGIN {
   $TEMPDIR = tempdir TEMPDIR => 1;
}

END {
   system "rm", "-rf", $TEMPDIR;
}

sub msgbox {
   system $XMESSAGE, "-buttons", "OK", "-default", "OK", "-center", @_;
}

sub parse_header($) {
           local $/ = "\015\012\015\012";
           my $full = $_[0]->getline;
           my (%hdr);
           $hdr{lc $1} .= "$2"
             while $full =~ /\G
                   ([^:\000-\040]+):
                   [\011\040]*
                   ((?: [^\015\012]+ | \015\012[\011\040] )*)
                   \015\012
                   /gxc;
           $full =~ /\G\015\012$/
                      or return ();
           %hdr;
}


$SIG{__DIE__} = sub {
   (my $msg = $_[0]) =~ s/\n$//;
   msgbox $_[0];
   exit (1);
};

my $ua = new LWP::UserAgent;
$ua->env_proxy;

my $n = `uname -n`;
$n =~ tr/[\000-\040\177-\377]//d;

my $ch = "&ostype=unix&pver=1.0&node=$n";

$ua->agent("xpcse/0.1; unix-perl");

sub download {
   my ($url, $file) = @_;
   my $hdr = new HTTP::Headers Content_Type => "application/octet-stream", X_OS => 'Unix';
   my $res = $ua->request(new HTTP::Request GET => "$hdr{url}?command=fetch$ch", $hdr, "");
   if($res->is_success) {
      open my $f, ">", $file or die "can't open file '$file' $!";
      print $f $res->content;
      close $f;
   } else {
      die $res->error_as_HTML;
   }
}


# 2. parse

open my $request, "<$ARGV[0]\000"
   or die "unable to open submitted command file: $!\n";

our %hdr = parse_header $request;
close $request;
#unlink $ARGV[0]; # marc says you'll have a better life without this

for(qw(url extension content-type xpcse-protocol-version)) {
     die "protocol error: header \"$_\" missing" unless exists $hdr{$_};
}

die "Illegal protocol version $hdr{'xpcse-protocol-version'}" unless $hdr{'xpcse-protocol-version'} eq '1.0';

my $TEMP;
#$TEMP = "$TEMPDIR/$hdr{basename}$hdr{extension}" if exists $hdr{basename};

$hdr{extension} =~ s@/@@g; # security .)

$TEMP ||= "$TEMPDIR/xpcse$hdr{extension}";

# @@@

$dirty_wait = $hdr{dirty_wait} if $hdr{dirty_wait} =~ /^\d+$/;
$quiet = $hdr{quiet} if $hdr{quiet} =~ /^\d+$/;
$on_exit_only = $hdr{on_exit_only} if $hdr{on_exit_only} =~ /^\d+$/;
$check_ms = $hdr{check_ms} if $hdr{check_ms} =~ /^\d+$/ && $hdr{check_ms} >65;


# 3. create local file

download $hdr{url}, $TEMP;

die "no file $TEMP" unless -f $TEMP;

my $MTIME;

{
   $MTIME = time - 1;
   utime $MTIME, $MTIME, $TEMP;
}

# 4. start editor

my $editpid;

if (0 == ($editpid = fork)) {
   if($hdr{'content-type'} =~ /text\//) {
      exec qw(rxvt -g 90x25 -e vim), $TEMP;
   } else {
      local $ENV{MAILCAPS} = "$ENV{HOME}/.mailcap.xpcse:/etc/mailcap.xpcse:$ENV{MAILCAPS}";
      exec qw(rxvt -g 90x30 -e run-mailcap --action=edit), "$hdr{'content-type'}:$TEMP";
   }
   exit(255);
} elsif (!defined $editpid) {
   die "error while starting editor: $!\n";
}

# 5. poll file && upload

sub upload {
   my $file = do {
      local($/);
      open my $fh, "<$TEMP\000"
         or die "$TEMP: $!";
      <$fh>;
   };

   $MTIME = (stat $TEMP)[9] - 1;
   utime $MTIME, $MTIME, $TEMP;

   my $hdr = new HTTP::Headers Content_Type => $hdr{'content-type'};

   my $res = $ua->request(new HTTP::Request POST => "$hdr{url}?command=store$ch", $hdr, $file);

   if ($res->is_success) {
      my $content = $res->content;
      $content =~ s/^-+//;
      
      if ($res->code == 200 || length ($content) > 100) {
         !$quiet && msgbox -timeout => 1, $content;
      } else {
         msgbox $content;
      }
   } else {
      msgbox "UPLOAD FAILED\n" . $res->as_string;
   }
}

my ($dirty, $dwait) = (0,0);

do {
   select undef, undef, undef, $check_ms/1000;
   $MTIME2 = (stat $TEMP)[9];
   if($MTIME2 != $MTIME) {
      ($dirty, $dwait) = (1,0);
      $MTIME = $MTIME2;
   } else {
      if(!$on_exit_only && $dirty) {
         if(++$dwait > $dirty_wait) {
            ($dirty, $dwait) = (0,0);
            upload;
         }
      }
   }
} while $editpid != waitpid $editpid, WNOHANG;

($dirty || (stat $TEMP)[9] != $MTIME) and upload;


