Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

line 38

By: TankorSmash on Oct 8th, 2012  |  syntax: Perl  |  size: 7.11 KB  |  views: 47  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #!/usr/bin/perl
  2. # A simple web server that just listens for textarea filter requests
  3. # and runs an editor to manipulate the text.  Is intended to be
  4. # used with the TextAid extention for Chrome.
  5. #
  6. # NOTE:  If you use this on a shared system, you should configure TextAid
  7. # with a username & password and make sure that the saved authorization
  8. # config file stays secret!
  9.  
  10. use strict;
  11. use warnings;
  12. use threads;
  13. use Socket;
  14. use IO::Select;
  15. use File::Temp;
  16. use Getopt::Long;
  17.  
  18. # If you don't want to require authentication, set $REQUIRE_AUTH to 0.
  19. # When it is set to 1, the first authenticated request that is received
  20. # will be saved to the $SAVE_AUTH_FILE file.  All subsequent requests
  21. # are compared to that value.  To change your password, just remove the
  22. # file and make a new edit-server request using the new auth info.
  23. our $REQUIRE_AUTH = 0;
  24. our $SAVE_AUTH_FILE = "$ENV{HOME}/.edit-server-auth";
  25.  
  26. # Only accept requests from something that claims to be a chrome-extension.
  27. # Set this to 0 if you want other things to be able to use this script.
  28. our $REQUIRE_CHROME_EXTENSION = 1;
  29.  
  30. # Configures the port we listen on and if we allow only localhost requests.
  31. our $PORT = 9321;
  32. our $LOCALHOST_ONLY = 1;
  33.  
  34. # Configure the program that you want to run to handle the requests.
  35. # This editor invocation must NOT return control to this script until
  36. # you are done editing.
  37. #our $EDITOR_CMD = '/usr/bin/rgvim -f "%s"';
  38. our $EDITOR_CMD = "E:\\Program Files (x86)\\Vim\\vim73\\gvim.exe -f '%s'";
  39. #our $EDITOR_CMD = '/usr/bin/emacsclient -c "%s"';
  40.  
  41. # The settings to configure the temp dir and how soon old files are removed.
  42. # If TMPTEMPLATE contains the string -URL64-, then up to 64 chars of the munged
  43. # URL for the textarea's page will be included in the tmp file's filename.
  44. our $TMPDIR = 'C:\Users\Mark\Desktop';
  45. our $TMPTEMPLATE = 'edit-server-URL64-XXXXXX';
  46. our $TMPSUFFIX = '.txt';
  47. our $CLEAN_AFTER_HOURS = 4;
  48.  
  49. &Getopt::Long::Configure('bundling');
  50. GetOptions(
  51.     'verbose|v+' => \( my $verbosity = 0 ),
  52.     'help|h' => \( my $help_opt ),
  53. ) or usage();
  54. usage() if $help_opt;
  55.  
  56. umask 0077; # Disables all "group" and "other" perms when saving files.
  57. $|  = 1;
  58.  
  59. local *S;
  60. socket(S, PF_INET, SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!\n";
  61. setsockopt(S, SOL_SOCKET, SO_REUSEADDR, 1);
  62. if ($LOCALHOST_ONLY) {
  63.     bind(S, sockaddr_in($PORT, INADDR_LOOPBACK));
  64. } else {
  65.     bind(S, sockaddr_in($PORT, INADDR_ANY));
  66. }
  67. listen(S, 5) or die "listen failed: $!\n";
  68.  
  69. my $sel = IO::Select->new();
  70. $sel->add(*S);
  71.  
  72. while (1) {
  73.     my @con = $sel->can_read();
  74.     foreach my $con (@con) {
  75.         my $fh;
  76.         my $remote = accept($fh, $con);
  77.         my($port, $iaddr) = sockaddr_in($remote);
  78.         my $addr = inet_ntoa($iaddr);
  79.  
  80.         my $t = threads->create(\&do_edit, $fh);
  81.         $t->detach();
  82.     }
  83. }
  84.  
  85. exit;
  86.  
  87. # Read the text from the content body, edit it, and write it back as our output.
  88. sub do_edit
  89. {
  90.     my($fh) = @_;
  91.     binmode $fh;
  92.  
  93.     local $_ = <$fh>;
  94.     my($method, $path, $ver) = /^(GET|HEAD|POST)\s+(.*?)\s+(HTTP\S+)/;
  95.     print "Path: $path\n" if $verbosity >= 1;
  96.     unless (defined $ver) {
  97.         http_header($fh, 500, 'Invalid request.');
  98.         close $fh;
  99.         return;
  100.     }
  101.     if ($method ne 'POST') {
  102.         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.');
  103.         close $fh;
  104.         return;
  105.     }
  106.  
  107.     my %header;
  108.  
  109.     while (<$fh>) {
  110.         s/\r?\n$//;
  111.         last if $_ eq '';
  112.  
  113.         my($name, $value) = /^(.*?): +(.*)/;
  114.         $header{lc($name)} = $value;
  115.         print "Header: \L$name\E = $value\n" if $verbosity >= 2;
  116.     }
  117.     print "-------------------------------------------------------------------\n" if $verbosity >= 2;
  118.  
  119.     if ($REQUIRE_AUTH) {
  120.         my $authorized;
  121.         my $auth = $header{authorization}; # e.g. "Basic 01234567890ABCDEF=="
  122.         if (defined $auth) {
  123.             my $line;
  124.             if (open AUTH, '<', $SAVE_AUTH_FILE) {
  125.                 chomp($line = <AUTH>);
  126.                 close AUTH;
  127.             } elsif ($!{ENOENT} && open AUTH, '>', $SAVE_AUTH_FILE) {
  128.                 # The first request w/o an auth file saves the auth info.
  129.                 print AUTH $auth, "\n";
  130.                 close AUTH;
  131.                 $line = $auth;
  132.             } else {
  133.                 http_header($fh, 501, 'Internal failure -- auth-file failed.');
  134.                 close $fh;
  135.                 return;
  136.             }
  137.             if ($line eq $auth) {
  138.                 $authorized = 1;
  139.             }
  140.         }
  141.         unless ($authorized) {
  142.             http_header($fh, 401, 'Unauthorized!');
  143.             close $fh;
  144.             return;
  145.         }
  146.     }
  147.  
  148.     if ($REQUIRE_CHROME_EXTENSION) {
  149.         my $origin = $header{origin};
  150.         unless (defined $origin && $origin =~ /^chrome-extension:/) {
  151.             http_header($fh, 401, 'Unauthorized.');
  152.             close $fh;
  153.             return;
  154.         }
  155.     }
  156.  
  157.     my $len = $header{'content-length'};
  158.     unless (defined $len && $len =~ /^\d+$/) {
  159.         http_header($fh, 500, 'Invalid request -- no content-length.');
  160.         close $fh;
  161.         return;
  162.     }
  163.  
  164.     my $got = read($fh, $_, $len);
  165.     if ($got != $len) {
  166.         http_header($fh, 500, 'Invalid request -- wrong content-length.');
  167.         close $fh;
  168.         return;
  169.     }
  170.  
  171.     my($query) = $path =~ /\?(.+)/;
  172.     (my $template_fn = $TMPTEMPLATE) =~ s/-URL(\d+)-/ '-' . url_filename($query, $1) . '-' /e;
  173.  
  174.     my $tmp = new File::Temp(
  175.         TEMPLATE => $template_fn,
  176.         DIR => $TMPDIR,
  177.         SUFFIX => $TMPSUFFIX,
  178.         UNLINK => 0,
  179.     );
  180.     my $name = $tmp->filename;
  181.  
  182.     print $tmp $_;
  183.     close $tmp;
  184.  
  185.     my $cmd = sprintf($EDITOR_CMD, $name);
  186.     system $cmd;
  187.  
  188.     unless (open FILE, '<', $name) {
  189.         http_header($fh, 500, "Unable to re-open $name: $!");
  190.         close $fh;
  191.         return;
  192.     }
  193.  
  194.     http_header($fh, 200, 'OK', '');
  195.     print $fh <FILE>;
  196.  
  197.     close FILE;
  198.     close $fh;
  199.  
  200.     # Clean-up old tmp files that have been around for a few hours.
  201.     if (opendir(DP, $TMPDIR)) {
  202.         (my $match = quotemeta($TMPTEMPLATE . $TMPSUFFIX)) =~ s/(.*[^X])(X+)/ $1 . ('\w' x length($2)) /e;
  203.         $match =~ s/\\-URL\d+\\-/-.*-/;
  204.         print "Match: $match\n" if $verbosity >= 3;
  205.         foreach my $fn (grep /^$match$/o, readdir DP) {
  206.             $fn = "$TMPDIR/$fn";
  207.             print "Fn: $fn\n" if $verbosity >= 3;
  208.             my $age = -M $fn;
  209.             if ($age > $CLEAN_AFTER_HOURS/24) {
  210.                 unlink $fn;
  211.             } else {
  212.                 print "Age: $age\n" if $verbosity >= 3;
  213.             }
  214.         }
  215.         closedir DP;
  216.     }
  217. }
  218.  
  219. sub http_header
  220. {
  221.     my $fh = shift;
  222.     my $status = shift;
  223.     my $status_txt = shift;
  224.     @_ = $status_txt unless @_;
  225.     print $fh "HTTP/1.0 $status $status_txt\r\n",
  226.               "Server: edit-server\r\n",
  227.               "Content-Type: text/plain\r\n",
  228.               "\r\n", @_;
  229. }
  230.  
  231. sub url_filename
  232. {
  233.     my($query, $max_chars) = @_;
  234.     print "Query: $query\n" if $verbosity >= 4;
  235.  
  236.     if (defined $query) {
  237.         foreach my $var_val (split /&/, $query) {
  238.             my($var, $val) = split /=/, $var_val, 2;
  239.             if ($var eq 'url') {
  240.                 print "Before: $val\n" if $verbosity >= 4;
  241.                 $val =~ s/\%([0-9a-fA-F]{2})/ chr hex $1 /eg;
  242.                 $val =~ s{^https?://}{};
  243.                 $val =~ s/[^-\w.]+/_/g;
  244.                 $val =~ s/^(.{1,$max_chars}).*/$1/;
  245.                 print "After: $val\n" if $verbosity >= 4;
  246.                 return $val;
  247.             }
  248.         }
  249.     }
  250.  
  251.     return 'unknown-url';
  252. }
  253.  
  254. sub usage
  255. {
  256.     die <<EOT;
  257. Usage: edit-server [OPTIONS]
  258.  
  259. Options:
  260.  -v, --verbose     Increase debug verbosity (repeatable)
  261.  -h, --help        Output this help message
  262. EOT
  263. }