http-rpc.pl

#!/usr/bin/env perl
# Time-stamp: <2011-03-30 19:06:07 JST, hirose31>
#
# リモートから HTTP でコマンドリクエストを受け取って、ローカルで
# コマンドを実行する。
# リモートからのブラウザのリロードとかでつかう。
#

use strict;
use warnings;
use IO::File;
STDOUT->autoflush(1);

# ==========================================================================

use HTTP::Daemon;
use HTTP::Response;
use HTTP::Headers;
use HTTP::Status qw(:constants status_message);

my %RPC = (
    '/reload/chrome' => {
        description => 'reload Chrome',
        command     => q{osascript -e "tell application \\"Google Chrome\\" to reload active tab of window 1"},
       },

    '/reload/safari' => {
        description => 'reload Safari',
        command     => q[cat <<EOOSA | osascript -
tell application "Safari"
  set sameURL to URL of tab 1 of front window
  set URL of tab 1 of front window to sameURL
end tell
EOOSA
],
    },

    '/super-reload/safari' => {
        description => 'super reload Safari',
        command     => q[cat <<EOOSA | osascript -
tell application "Safari"
  --confirms your browser is the front application
  activate
end tell

tell application "System Events"
  tell process "Safari"
    keystroke "r" using {command down}
  end tell
end tell
EOOSA
],
       },
   );

my $httpd = HTTP::Daemon->new(
    LocalAddr => '0.0.0.0', # fixme コマンドラインオプションで設定可能にする
    LocalPort => 5555,
    ReuseAddr => 1,
   ) or die $!;

my $base_url = $httpd->url;
$base_url =~ s{/$}{};
for my $path (sort keys %RPC) {
    printf "$base_url%s\n  %s\n", $path, $RPC{$path}{description};
}

# code, content
*HTTP::Daemon::ClientConn::send_text_response = sub {
    my $self = shift;
    my($code, $content) = @_;
    $content ||= status_message($code)."\n";
    my $res = HTTP::Response->new($code,
                                  status_message($code),
                                  HTTP::Headers->new('Content-Type', 'text/plain'),
                                  $content,
                                 );
    $self->send_response($res);
};

while (my $c = $httpd->accept) {
    while (my $r = $c->get_request) {
        if ($r->method eq 'GET') {
            ### path: $r->uri->path
            if (my $rpc = $RPC{ $r->uri->path }) {
                printf "> %s\n", $rpc->{description};
                my $rc = system $rpc->{command};
                if ($rc == 0) {
                    $c->send_text_response(HTTP_OK, "OK\n");
                } else {
                    $c->send_text_response(HTTP_INTERNAL_SERVER_ERROR,
                                           sprintf("exist with: %d\n",
                                                   $? == -1 ? $? :
                                                   $? & 127 ? $? & 127 :
                                                   $? >> 8
                                                  ));
                }
            } else {
                $c->send_text_response(HTTP_NOT_FOUND);
            }
        } else {
            $c->send_text_response(HTTP_FORBIDDEN);
        }
    }
    $c->close;
    undef($c);
}

__END__

reload-chrome

#!/bin/sh
[ $# -eq 1 ] || { echo 'usage: reload-chrome HOST'; exit 1; }
host=$1

curl http://$host:5555/reload/chrome

reload-safari

#!/bin/sh
[ $# -eq 1 ] || { echo 'usage: reload-safari HOST'; exit 1; }
host=$1

curl http://$host:5555/reload/safari