#!/usr/bin/perl
# A simple web server that just listens for textarea filter requests
# and runs an editor to manipulate the text.  Is intended to be
# used with the TextAid extention for Chrome.
#
# NOTE:  If you use this on a shared system, you should configure TextAid
# with a username & password and make sure that the saved authorization
# config file stays secret!
#
# Initial version by Wayne Davison (c) 2010
# Refactoring and win32 support by Sébastien Kirche (c) 2011 

use strict;
use warnings;
use threads;
use Socket;
use IO::Select;
use File::Temp;

our $CFGFILE = 'edit-server.cfg';

# If you don't want to require authentication, set $REQUIRE_AUTH to 0.
# When it is set to 1, the first authenticated request that is received
# will be saved to the $SAVE_AUTH_FILE file.  All subsequent requests
# are compared to that value.  To change your password, just remove the
# file and make a new edit-server request using the new auth info.
our $REQUIRE_AUTH = 0; #1
our $SAVE_AUTH_FILE;

# Only accept requests from something that claims to be a chrome-extension.
# Set this to 0 if you want other things to be able to use this script.
our $REQUIRE_CHROME_EXTENSION = 0; #1

# Configures the port we listen on and if we allow only localhost requests.
our $PORT = 8888;
our $LOCALHOST_ONLY = 0; #1

if (my $err = readcfg($CFGFILE)) {
    print(STDERR $err, "\n");
    exit(1);
}

our $platform = $CFG::CFG{'platform'};
if ($platform eq "win32") {	
	$SAVE_AUTH_FILE = "$ENV{HOMEPATH}/.edit-server-auth";
	eval "
		use Win32::Process;
		use Win32;
	";
}
else{
	$SAVE_AUTH_FILE = "$ENV{HOME}/.edit-server-auth";
}

# Configure the program that you want to run to handle the requests.
our $EDITOR_CMD = $CFG::EDIT_COMMANDS{$CFG::CFG{'command_set'}}{'editor_cmd'};
our $EDITOR_ARGS = $CFG::EDIT_COMMANDS{$CFG::CFG{'command_set'}}{'editor_args'};

print "DEBUG : EDITOR_CMD=$EDITOR_CMD\nEDITOR_ARGS=$EDITOR_ARGS\n";

# The settings to configure the temp dir and how soon old files are removed.
#~ our $TMPDIR = '/tmp';
our $TMPDIR = $CFG::CFG{'TMPDIR'};
our $TMPTEMPLATE = 'edit-server-XXXXXX';
our $TMPSUFFIX = '.txt';
our $CLEAN_AFTER_HOURS = 4;

umask 0077; # Disables all "group" and "other" perms when saving files.
$|  = 1;

local *S;
socket(S, PF_INET, SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!\n";
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);
if ($LOCALHOST_ONLY) {
    bind(S, sockaddr_in($PORT, INADDR_LOOPBACK));
} else {
    bind(S, sockaddr_in($PORT, INADDR_ANY));
}
listen(S, 5) or die "listen failed: $!\n";

my $sel = IO::Select->new();
$sel->add(*S);

while (1) {
    my @con = $sel->can_read();
    foreach my $con (@con) {
		my $fh;
		my $remote = accept($fh, $con);
		my($port, $iaddr) = sockaddr_in($remote);
		my $addr = inet_ntoa($iaddr);

		print "$addr\n"; #debug

		my $t = threads->create(\&do_edit, $fh);
		$t->detach();
    }
}

exit;

# Read the text from the content body, edit it, and write it back as our output.
sub do_edit
{
    my($fh) = @_;
    binmode $fh;

    local $_ = <$fh>;
	
	print "$_\n"; #debug
	
    my($method, $path, $ver) = /^(GET|HEAD|POST)\s+(.*?)\s+(HTTP\S+)/;
	
	print $method, $path, $ver . "\n" if defined $method; #debug
	
    unless (defined $ver) {
		http_header($fh, 500, 'Invalid request.');
		close $fh;
		return;
    }
    if ($method ne 'POST') {
		http_header($fh, 200, 'OK', 'Server is up and running.  To use it, issue a POST request with the file to edit as the content body.');
		close $fh;
	return;
    }

    my %header;

    while (<$fh>) {
		s/\r?\n$//;
		last if $_ eq '';
		
		my($name, $value) = /^(.*?): +(.*)/;
		$header{lc($name)} = $value;
    }

    if ($REQUIRE_AUTH) {
		my $authorized;
		my $auth = $header{authorization}; # e.g. "Basic 01234567890ABCDEF=="
		if (defined $auth) {
			my $line;
			if (open AUTH, '<', $SAVE_AUTH_FILE) {
				chomp($line = <AUTH>);
				close AUTH;
			} elsif ($!{ENOENT} && open AUTH, '>', $SAVE_AUTH_FILE) {
				# The first request w/o an auth file saves the auth info.
				print AUTH $auth, "\n";
				close AUTH;
				$line = $auth;
			} else {
				http_header($fh, 501, 'Internal failure -- auth-file failed.');
				close $fh;
				return;
			}
			if ($line eq $auth) {
				$authorized = 1;
			}
		}
		unless ($authorized) {
			http_header($fh, 401, 'Unauthorized!');
			close $fh;
			return;
		}
    }

    if ($REQUIRE_CHROME_EXTENSION) {
		my $origin = $header{origin};
		unless (defined $origin && $origin =~ /^chrome-extension:/) {
			http_header($fh, 401, 'Unauthorized.');
			close $fh;
			return;
		}
    }

    my $len = $header{'content-length'};
    unless (defined $len && $len =~ /^\d+$/) {
		http_header($fh, 500, 'Invalid request -- no content-length.');
		close $fh;
		return;
    }

    my $got = read($fh, $_, $len);
    if ($got != $len) {
		http_header($fh, 500, 'Invalid request -- wrong content-length.');
		close $fh;
		return;
    }

    my $tmp = new File::Temp(
		TEMPLATE => $TMPTEMPLATE,
		DIR => $TMPDIR,
		SUFFIX => $TMPSUFFIX,
		UNLINK => 0,
		);
    my $name = $tmp->filename;

    print $tmp $_;
    close $tmp;

	if ($platform eq "unix") {
		my $cmd = sprintf($EDITOR_CMD, $name);
		system $cmd;
	} 
	elsif ($platform eq "win32") {
		#~ $name =~ s:\\:\\\\:g;
		my $args = sprintf($EDITOR_ARGS, $name);
		my $process;
		sub ErrorReport{
			print Win32::FormatMessage( Win32::GetLastError() );
		}
		print "Debug: Win32::Process::Create $EDITOR_CMD $args\n";
		eval '
		Win32::Process::Create($process,
							   $EDITOR_CMD,
							   $args,
							   0,
							   NORMAL_PRIORITY_CLASS,
							   ".")|| Win32::MsgBox ErrorReport();
		$process->Wait(INFINITE);';
	}

    unless (open FILE, '<', $name) {
		http_header($fh, 500, "Unable to re-open $name: $!");
		close $fh;
		return;
    }

    http_header($fh, 200, 'OK', '');
    print $fh <FILE>;

    close FILE;
    close $fh;

    # Clean-up old tmp files that have been around for a few hours.
    if (opendir(DP, $TMPDIR)) {
		(my $match = quotemeta($TMPTEMPLATE . $TMPSUFFIX)) =~ s/(.*)(X+)/ $1 . ('.' x length($2)) /e;
		foreach my $fn (grep /^$match$/o, readdir DP) {
			$fn = "$TMPDIR/$fn";
			if (-M $fn > $CLEAN_AFTER_HOURS/24) {
				unlink $fn;
			}
		}
		closedir DP;
    }
}

sub http_header
{
    my $fh = shift;
    my $status = shift;
    my $status_txt = shift;
    @_ = $status_txt unless @_;
    print $fh "HTTP/1.0 $status $status_txt\r\n",
	      "Server: edit-server\r\n",
	      "Content-Type: text/plain\r\n",
	      "\r\n", @_;
}

sub readcfg{
    my $file = $_[0];
    our $err;
    {   # use a namespace
        package CFG;

        # read config
        my $rc = do($file);

        # check for errorsc
        if ($@) {
            $::err = "ERROR: Failure compiling '$file' - $@";
        } elsif (! defined($rc)) {
            $::err = "ERROR: Failure reading '$file' - $!";
        } elsif (! $rc) {
            $::err = "ERROR: Failure processing '$file'";
        }
    }
    return ($err);
}

# Local Variables:
# mode: Cperl
# coding: utf-8-unix
# truncate-lines: t
# time-stamp-format: "%02d/%02m/%:y %02H:%02M %u@%s"
# End:
