micro typeでの準備

perl5 on AMI Linux t1.micro

awsを使ってapi.hakoniwa.com用の環境を作ってみようと思いました.試しに作ってみたときのメモです.用意したインスタンスは,

AMI: Amazon Linux AMI ID ami-2272864b (x86_64)
Name: Basic 64-bit Amazon Linux AMI 1.0

です.まずはインスタンスsshして

$ ssh -i .ssh/awskey -o ServerAliveInterval=5 ec2-user@ec2- ... amazonaws.com

後は普段通りにperl5をインストールします.

$ sudo yum update
$ sum yum groupinstall 'Development Tools'
$ sudo yum install git
$ curl -LO http://xrl.us/perlbrew
$ chmod +x perlbrew
$ ./perlbrew install
$ /home/ec2-user/perl5/perlbrew/bin/perlbrew init

ここまでできたら,~/.bashrcに以下の行を追加します.

source /home/ec2-user/perl5/perlbrew/etc/bashrc

さらに作業を続けます.

$ . .bashrc
$ perlbrew install perl-5.12.2
$ perlbrew switch perl-5.12.2
$ curl -L http://cpanmin.us/ | perl - App::cpanminus
$ cpanm  App::cpanoutdated
$ cpanm  App::pmuninstall
$ cpan-outdated | cpanm

これでperl5がインストールできました.

perl6 on AMI Linux t1.micro

使うつっもりはまだないですが,JPerl Advent Calendar 2010 Perl6 Tracを読んでperl6にも興味を持ちました.perl5をインストールしたついでにperl6のインストール方法もまとめてみました.AMIは上と同じようにt1.microを使っています.

$ sudo yum update
$ sudo yum groupinstall 'Development Tools'
$ sudo yum install git
$ sudo yum install libicu-devel

m1.typeの環境ではperl6作成の時にメモリがたりず,oom killerが発動します.そのためswap領域を追加しておきます.

$ sudo dd if=/dev/zero of=/myswap0 bs=1M count=2048
$ sudo mkswap /myswap0
$ sudo swapon /myswap0

これで,/proc/swapsを見ると以下のようになっているはずです.

Filename                    Type          Size     Used     Priority
/myswap0                                file          2097148     0     -1

次にbootした時にもswapを使えるようにするためには/etc/fstabに以下の行を追加しておきます.

/myswap0     swap     swap     defaults     0     0

これで準備ができました.AMI Linuxにはperl5が入っているので,そのまま使えば…と思ったのですが,perl6を作る際にエラーが出たので上と同じようにインストールしました.

$ curl -LO http://xrl.us/perlbrew
$ chmod +x perlbrew
$ ./perlbrew install
$ /home/ec2-user/perl5/perlbrew/bin/perlbrew init
## Add next line to the ~/.bashrc
source /home/ec2-user/perl5/perlbrew/etc/bashrc
$ . .bashrc
$ perlbrew install perl-5.12.2
$ perlbrew switch perl-5.12.2

さぁこれでperl6を作る準備ができました.

$ git clone git://github.com/rakudo/rakudo.git
$ cd rakudo
$ perl Configure.pl--gen-parrot
$ make
$ make install

Configure.plには15分ぐらい,makeには7時間ぐらいかかります.これでできるperl6はrakudo環境のみでrakudo starディストリビューションに入っているモジュールが入っていません(ファイルははいってるんだけど,ライブラリパスとは違う場所に入っていたり,そもそもなかったり).そのため公開されているモジュールを使ってみよう - JPerl Advent Calendar 2010 Perl6 Trackで紹介されているneutroコマンドを使って必要なモジュールをインストールする必要があります.
といっても,モジュールがないことに気づいてrakudo starに切り替えてそのあとにneutroのことを知ったので,実際に試していません.もし違っていたら,ここの文章を書き直すようにします.

Perl版のHerokuを作りたい

発端

最近Salesforceに買われたのでちまたでも有名になったHeroku,RubyOnRailsをオンデマンドで使う事ができるサービスです.このサービスではgitで管理しているソースをHeroku環境にデプロイしてmakeするとwebアプリケーションを実行できます.似たようなことをPerlでもやってみたいなと思っていました.
一方で子飼さんが作ったlleval - run codes from your browserというサービスと,これを元にした宮川さんのhttp://sunaba.plackperl.org/app/jrl_h69c3xgmlha_byudvgというサービス(というかproof-of-conceptかな)が動いています.これらの巨人(子飼さんはともかく宮川さんはでかくないけど)の偉業を足がかりにすればできるんじゃないかと思いつきました.
そして,最近iTunes App StoreCodeToGoというアプリを見つけて,もしかしたらニーズもあるかもしれないと思うようになりました.ビジネスモデルは(苦手だから)後回しにして,とりあえず動きそうなアーキテクチャを考えてみることにしました.

構想

アーキテクチャに名前がないと説明しにくいのでHakoniwa(箱庭)という名前を付けてみました.まず,ローカル環境に必要なアプリケーションをインストールして,

$ cpanm App::Hakoniwa

例えば,bonsan(盆山)ってwebアプリを作る場合には

$ hakoniwa create bonsan

とします.するとHakoniwaがaws(amazon web service)上にbonsan.hakoniwa.com, bonsan.api.hakoniwa.comという名前のサーバ(AMIインスタンス)用意します.bonsan.hakoniwa.comにはsunaba(もしくはその拡張)が,bonsan.api.hakoniwa.comにはlleval(の移植版)が動きます.
次にデプロイするにはgitを使います.Hakoniwaが必要な環境変数(の初期値を)用意しておけばgitがそのまま使えるかなと.

$ git push hakoniwa master

アプリケーションを起動はこれでいいかな.

$ hakoniwa plackup bonsan

負荷分散は要求に応じてbonsan001, bonsan002...とアプリケーションサーバを増やして,それをsunabaに組み込んだproxy機能で分散させればいいと思っています.
hakoniwaのコマンドオプションはこれぐらいあればいいかと.

$ hakoniwa --help
help                 # show this usage
version              # show hakoniwa version
list                 # list your apps
create <name>        # create a new app
destroy <name>       # destroy the app permanently
info [<name>]        # show app info, like web url and git rep
api:add [<num>]      # add api server
api:del [<num>]      # delete api server
keys                 # show your user's public keys
keys:add [<path to keyfile>] # add a public key
keys:remove <keyname>        # remove a key by keyname
keys:clear                   # remove all keys
domains:add <domain>         # add a custom domain name
domains:remove <domain>      # remove a custom domain name
domains:clear                # remove all custom domains
ssl:add <pem> <key>          # add SSL cert to the app
ssl:remove <domain>          # removes SSL cert from the app domain
pm                           # list installed modules
pm:install <perl_module>     # install the module from CPAN
pm:uninstall <perl_nmodule>  # remove mod
pm:update <perl_module>      # update specified module

apiサーバが複数あるからsshして作業するわけにはいかないだろうから,capistranoも使えるようにする必要があるかもしれないなぁ.とまぁ,こんな記事を書いておいたら誰か作ってくれないかな,と淡い期待.それともこんな仕組みには誰も興味ないでしょうか.

forkできない環境をx86_64 linuxで その1

はじめに

YAPC::Asia 2010 Tokyoで子飼さんのInside LLEvalを聞いて,同じような環境を普段使ってるlinux上で作ってみたいなと思いました.FreeBSD::i386::Ptrace - Ptrace for FreeBSD-i386 - metacpan.orgをみてptraceを使えばできそうだと考えましたが,FreeBSDLinuxでは使い方が違うし,Linuxでもi386x86_64でも違うことに気づいたので,まずは調べたところまでをまとめることにしました.

ptraceでsyscallをリストアップ

いろいろ探した結果,Playing with ptrace, Part I | Linux Journalが参考になることがわかりました.でもこの記事はi386について書いてあってx86_64用のレジスタの情報がよくわかりませんでした.さらに探してtracef - function call tracerというプログラムの中身をみたところ

#if defined(__i386__) || defined(__x86_64__)
  #define BREAKPOINT_INSN      0xCC
  #define BREAKPOINT_INSN_LEN     1
  #if defined(__i386__) 
    #define SP_     esp
    #define PC_     eip
    #define RETVAL_ eax
  #else
    // x86_64
    #define SP_     rsp
    #define PC_     rip
    #define RETVAL_ rax
  #endif  
#else
  #error unknown arch
#endif

というのを見つけたので,orig_eaxの代わりにorig_raxを使えばよいということがわかりました.最後にx86_64syscallのリストを/usr/include/bits/syscall.hに見つけました.というところで動かしてみたサンプルプログラムはこんな感じになります.

#include <sys/ptrace.h>
#include <sys/types.h>
#include <inttypes.h>
#include <sys/wait.h>
#include <unistd.h>
#include <stdio.h>
#include <sys/reg.h>

const char *name[] = {
  "read",
  "write",
  "open",
  "close",
  "stat",
  "fstat",
  "lstat",
  "poll",
  "lseek",
  "mmap",
  "mprotect",
  "munmap",
  "brk",
  "rt_sigaction",
  "rt_sigprocmask",
  "rt_sigreturn",
  "ioctl",
  "pread64",
  "pwrite64",
  "readv",
  "writev",
  "access",
  "pipe",
  "select",
  "sched_yield",
  "mremap",
  "msync",
  "mincore",
  "madvise",
  "shmget",
  "shmat",
  "shmctl",
  "dup",
  "dup2",
  "pause",
  "nanosleep",
  "getitimer",
  "alarm",
  "setitimer",
  "getpid",
  "sendfile",
  "socket",
  "connect",
  "accept",
  "sendto",
  "recvfrom",
  "sendmsg",
  "recvmsg",
  "shutdown",
  "bind",
  "listen",
  "getsockname",
  "getpeername",
  "socketpair",
  "setsockopt",
  "getsockopt",
  "clone",
  "fork",
  "vfork",
  "execve",
  "exit",
  "wait4",
  "kill",
  "uname",
  "semget",
  "semop",
  "semctl",
  "shmdt",
  "msgget",
  "msgsnd",
  "msgrcv",
  "msgctl",
  "fcntl",
  "flock",
  "fsync",
  "fdatasync",
  "truncate",
  "ftruncate",
  "getdents",
  "getcwd",
  "chdir",
  "fchdir",
  "rename",
  "mkdir",
  "rmdir",
  "creat",
  "link",
  "unlink",
  "symlink",
  "readlink",
  "chmod",
  "fchmod",
  "chown",
  "fchown",
  "lchown",
  "umask",
  "gettimeofday",
  "getrlimit",
  "getrusage",
  "sysinfo",
  "times",
  "ptrace",
  "getuid",
  "syslog",
  "getgid",
  "setuid",
  "setgid",
  "geteuid",
  "getegid",
  "setpgid",
  "getppid",
  "getpgrp",
  "setsid",
  "setreuid",
  "setregid",
  "getgroups",
  "setgroups",
  "setresuid",
  "getresuid",
  "setresgid",
  "getresgid",
  "getpgid",
  "setfsuid",
  "setfsgid",
  "getsid",
  "capget",
  "capset",
  "rt_sigpending",
  "rt_sigtimedwait",
  "rt_sigqueueinfo",
  "rt_sigsuspend",
  "sigaltstack",
  "utime",
  "mknod",
  "uselib",
  "personality",
  "ustat",
  "statfs",
  "fstatfs",
  "sysfs",
  "getpriority",
  "setpriority",
  "sched_setparam",
  "sched_getparam",
  "sched_setscheduler",
  "sched_getscheduler",
  "sched_get_priority_max",
  "sched_get_priority_min",
  "sched_rr_get_interval",
  "mlock",
  "munlock",
  "mlockall",
  "munlockall",
  "vhangup",
  "modify_ldt",
  "pivot_root",
  "_sysctl",
  "prctl",
  "arch_prctl",
  "adjtimex",
  "setrlimit",
  "chroot",
  "sync",
  "acct",
  "settimeofday",
  "mount",
  "umount2",
  "swapon",
  "swapoff",
  "reboot",
  "sethostname",
  "setdomainname",
  "iopl",
  "ioperm",
  "create_module",
  "init_module",
  "delete_module",
  "get_kernel_syms",
  "query_module",
  "quotactl",
  "nfsservctl",
  "getpmsg",
  "putpmsg",
  "afs_syscall",
  "tuxcall",
  "security",
  "gettid",
  "readahead",
  "setxattr",
  "lsetxattr",
  "fsetxattr",
  "getxattr",
  "lgetxattr",
  "fgetxattr",
  "listxattr",
  "llistxattr",
  "flistxattr",
  "removexattr",
  "lremovexattr",
  "fremovexattr",
  "tkill",
  "time",
  "futex",
  "sched_setaffinity",
  "sched_getaffinity",
  "set_thread_area",
  "io_setup",
  "io_destroy",
  "io_getevents",
  "io_submit",
  "io_cancel",
  "get_thread_area",
  "lookup_dcookie",
  "epoll_create",
  "epoll_ctl_old",
  "epoll_wait_old",
  "remap_file_pages",
  "getdents64",
  "set_tid_address",
  "restart_syscall",
  "semtimedop",
  "fadvise64",
  "timer_create",
  "timer_settime",
  "timer_gettime",
  "timer_getoverrun",
  "timer_delete",
  "clock_settime",
  "clock_gettime",
  "clock_getres",
  "clock_nanosleep",
  "exit_group",
  "epoll_wait",
  "epoll_ctl",
  "tgkill",
  "utimes",
  "vserver",
  "mbind",
  "set_mempolicy",
  "get_mempolicy",
  "mq_open",
  "mq_unlink",
  "mq_timedsend",
  "mq_timedreceive",
  "mq_notify",
  "mq_getsetattr",
  "kexec_load",
  "waitid",
  "add_key",
  "request_key",
  "keyctl",
  "ioprio_set",
  "ioprio_get",
  "inotify_init",
  "inotify_add_watch",
  "inotify_rm_watch",
  "migrate_pages",
  "openat",
  "mkdirat",
  "mknodat",
  "fchownat",
  "futimesat",
  "newfstatat",
  "unlinkat",
  "renameat",
  "linkat",
  "symlinkat",
  "readlinkat",
  "fchmodat",
  "faccessat",
  "pselect6",
  "ppoll",
  "unshare",
  "set_robust_list",
  "get_robust_list",
  "splice",
  "tee",
  "sync_file_range",
  "vmsplice",
  "move_pages",
  "utimensat",
  "epoll_pwait",
  "signalfd",
  "timerfd_create",
  "eventfd",
  "fallocate",
};

int main()
{
  pid_t child;
  uint64_t orig_rax;
  child = fork();
  int status;
  if(child == 0) {
    ptrace(PTRACE_TRACEME, 0, NULL, NULL);
    execl("/bin/ls", "ls", NULL);
  }
  else {
    while(1) {
      wait(&status);
      if(WIFEXITED(status))
        break;
      orig_rax = ptrace(PTRACE_PEEKUSER, child, 8 * ORIG_RAX, NULL);
      printf("The child made a system call %s\n", name[orig_rax]);
      ptrace(PTRACE_SYSCALL, child, NULL, NULL);
    }
  }
  return 0;
}

このプログラムをtest.cとすると,

gcc -Wall test.c

として,できたa.outを動かしてみた結果は次のようになります.

$ ./a.out
The child made a system call execve
The child made a system call brk
The child made a system call brk
The child made a system call mmap
The child made a system call mmap
...
a.out  test2.c	test3.c  test.c
The child made a system call write
The child made a system call close
The child made a system call close
The child made a system call munmap
The child made a system call munmap
The child made a system call exit_group

こんな方法でcloneとforkとvforkを探して,見つかったらプロセスを止めればいいのかなと思っています.

今後の課題

  • 疑問:レジスタの使い方は何をみればいいんだろう.i386x86_64,もしかしたらkernelのバージョンによっても違うんだろうか.
  • 問題:xsの使い方を完全に忘れてしまっているので,どうやってperlモジュールにすればいいのか悩むところ.
  • 疑問:PTRACE_CONTとPTRACE_SYSCALLの違いがわからない.ぐぐって探してるのが悪いのかしら.でもman 2 ptraceででてこないのは何が入ってないんだろう
  • 疑問:FreeBSD::i386::Ptraceのnofork.plをみると,%SYSにシステムコール一覧が入ってるみたいなんだけど,これどうやって作ってるんだろう
  • 問題:llevalの話の中では,'1 while 1'の実行を1秒で止めるとなっているんだけど,これはどうやって実現してるのかなぁ.OPcodeを解析するのかしらん.

たぶん続く

XIRCDのTwitterコンポーネントをOAuth対応に

月日は百代の過客にして 行き交う年もまた旅人

id:naoyaさんもグリーに移り,Twitterでベーシック認証が使えなくなった今日このごろ皆様いかがおすごしでしょうか.毎日暑いですね.とかこんなこと書いてると,後で見直したときになんのこっちゃ,とか思うんだろうなぁ.
そんなことは置いといて,Basic認証を使っていたXIRCDのTwitterコンポーネントが使えなくなりました.昼休みにちょこっと書き直してみたのでそのまとめです.

XIRCD

普段使っているバージョンはGitHub - tokuhirom/xircdで,これを書き直しました.

package XIRCD::Component::Twitter;
use XIRCD::Component;
use AnyEvent;
use AnyEvent::twitter;
use Encode;

with 'XIRCD::Role::Dedup';

has 'consumer_key'        => ( isa => 'Str', is => 'rw' );
has 'consumer_secret'     => ( isa => 'Str', is => 'rw' );
has 'access_token'        => ( isa => 'Str', is => 'rw' );
has 'access_token_secret' => ( isa => 'Str', is => 'rw' );
has 'retry' => ( isa => 'Int', is => 'rw', default => sub { 60 } );

has ua => (
    is      => 'rw',
    isa     => 'AnyEvent::Twitter',
    lazy    => 1,
    builder => 'build_ua',
);

sub build_ua {
    my $self = shift;
    AnyEvent::Twitter->new(
        consumer_key        => $self->consumer_key,
        consumer_secret     => $self->consumer_secret,
        access_token        => $self->access_token,
        access_token_secret => $self->access_token_secret,
    );
}

sub receive_message {
    my ( $self, $status ) = @_;
    debug "send message $status";

    $self->ua->request(
        api    => 'statuses/update',
        method => 'POST',
        params => { status => $status },
        sub { }
    );

}

sub init {
    my $self = shift;
    debug "read twitter";

    timer(
        interval => $self->retry,
        cb       => sub {
            $self->ua->request(
                api    => 'statuses/friends_timeline',
                method => 'GET',
                sub {
                    my ( $hdr, $res, $reason ) = @_;
                    for my $line ( reverse @{ $res || [] } ) {
                        next if $self->deduper->{ $line->{id} }++;
                        $self->publish_message(
                            $line->{user}->{screen_name} => $line->{text} );
                    }
                },
            );
        },
    );
}

1;

エラー処理はなにもやっていないし,沢山updateがあると取りこぼしてそう.でもとりあえず動いたので使ってみてます.

ubf解析 その1

まずは動かしてみる

ubfは仕様の文章化が進んでいないので,実装の動作から逆に仕様を探って行く必要があります.erlangのプログラムを解析するのが私には難しいので,テストケースを追いかけてみました.調べているのは

$ git log
commit 458aa25abcd14473b8723db1f6d377dd4fc4a704
Author: Joseph Wayne Norton
Date: Tue Jun 29 20:46:41 2010 +0900

UBF requires Erlang/OTP R13B01 or newer
...

というバージョンです.

make check

installまでの手順でmake checkする項目がありました.

$ make -n check
rm -f ./*.log
env ERL_MAX_ETS_TABLES=10007 erl +A 64 +K true -smp auto \
 +Mis true -sname runerl1 -pz ../ebin  \
-kernel net_ticktime 60 -config ../priv/sys \
-pz ./Unit-Test-Files -pz ./Unit-EUnit-Files \
-pz ./Unit-Quick-Files    -noinput -noshell \
-pz ./Unit-Test-Files -pz ./Unit-EUnit-Files \
                -s ubf_test tests \
                -s test_ubf tests \
                -s test_ebf tests \
                -s test_etf tests \
                -s stateless_plugin_test do_eunit \
                -s stateful_plugin_test do_eunit \
                -s erlang halt \
                > ./check.log

ずいぶん沢山引数がありますが,ざっとみてみると

引数 概要
env ERL_MAX_ETS_TABLES=10007 標準1400のETSテーブルの数を10007に
+A 64 async thread pool数
+K true emuで使えるようならkernel poll機能を使う
-smp auto SMPモードで起動
+Mis true Status over allocated memoryをemuで保持
-sname runerl1 dnsが動作してない環境で分散erlangを実行
-pz ../ebin 検索パスの最後に../ebinを追加
-kernel net_ticktime 60 分散ノードの死活監視時間間隔
-config ../priv/sys 設定として ../priv/sys.config を使う
-noinput 入力を受け付けない
-noshell shellなしで起動する
-s ubf_test tests ubf_test ファイルのtestsメソッドを実行

という意味になっています.これを元に,一番簡単そうなubf_test.erlのtest9というメソッドを

test9() ->
    test_ubf({abc,"kdjhkshfkhfkhsfkhaf", [a,c,d]}).

実行してみると,

$ env ERL_MAX_ETS_TABLES=10007 erl +A 64 +K true \
-smp auto +Mis true -sname runerl1 -pz ../ebin  \
-kernel net_ticktime 60 -config ../priv/sys \
-pz ./Unit-Test-Files -pz ./Unit-EUnit-Files \
-pz ./Unit-Quick-Files -noinput -noshell \
-s ubf_test test9 -s erlang halt
encode test #Bin=49
L={'abc',#102&97&104&107&102&115&104&107&102&104&107&102&104&115&107&104&106&100&107&,#'d'&'c'&'a'&}$
ubf size =99
Identical

となりました.この実行結果はubr_test.erlの

test_ubf(T) ->
    B = term_to_binary(T),
    io:format("encode test #Bin=~p~n",[size(B)]),
    L = encode(T),
    %% io:format("L=~s~n",[L]),
    io:format("ubf size =~p~n",[length(L)]),
    Val = decode(L),
    case Val of
        {ok, T, _} ->
            io:format("Identical~n");
        X ->
            io:format("Differences (~p)~n", [X]),
            io:format("Val=~p~n",[T])
    end.

からio:formatのコメントアウトをはずした状態で実行しています.encodeしてdecodeした結果が元と同じになるのは当然ですね.

$ perl -le 'print join ",", unpack "C*", "kdjhkshfkhfkhsfkhaf"'
107,100,106,104,107,115,104,102,107,104,102,107,104,115,102,107,104,97,102

とやってみてみると,文字もスタックにおしりから積まれている状況がわかります.

サーバを動かしてみる

元の論文にも出ていたfile serverを動かして,今回の記事を終わりにします.file serverの動かし方はREADMEにもでてないし,Makefileにも書いてなかったので試行錯誤の末に見つけました.参考にしたのはfile_client.erlに書いてあったコメントです.ただ,このコメントもそのままでは動きませんでした.

$ env ERL_MAX_ETS_TABLES=10007 erl +A 64 +K true \
-smp auto +Mis true -sname runerl1 -pz ../ebin \
-kernel net_ticktime 60 -config ../priv/sys \
-pz ./Unit-Test-Files
Erlang R13B04 (erts-5.7.5) [source] [64-bit] [rq:1] [async-threads:64] [kernel-poll:true]

Eshell V5.7.5  (abort with ^G)
(runerl1@foo)1> ubf_server:start([file_plugin],file_client:defaultPort()).
true
(runerl1@foo)2> file_client:test().
DEBUG: Arg [] Pid <0.45.0>
Info = {ok,{'#S',"I am a mini file server"}}
ls: H_Data myFirstData0_is_not_used
ls: Env    <0.45.0>
Files=["check.log.20100708","erl_crash.dump","contract_yecc.erl",
       "contract_lex.erl","ubf_utils.erl","ubf_server.erl",
       "ubf_plugin_stateless.erl","ubf_plugin_stateful.erl",
       "ubf_plugin_meta_stateless.erl","ubf_plugin_meta_stateless.con",
       "ubf_plugin_meta_stateful.erl","ubf_plugin_meta_stateful.con",
       "ubf_plugin_meta.con","ubf_plugin_handler.erl","ubf_driver.erl",
       "ubf_client.erl","ubf.erl","proc_utils.erl","proc_socket_server.erl",
       "ebf_driver.erl","ebf.erl","contracts_abnf.erl","contracts.erl",
       "contract_yecc.yrl","contract_proto.erl","contract_parser.erl",
       "contract_manager_tlog.erl","contract_manager.erl","contract_lex.xrl",
       "contract_driver.erl","Unit-Test-Files","Unit-EUnit-Files","Makefile"]
got 8897 bytes for ubf.erl
test worked
ok
(runerl1@foo)3>

正しく動いているようです.ついでに,サーバにtelnetからアクセスしてみると,file_client:defaultPort()が2000なので,

$ telnet localhost 2000
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
{'ubf1.0',"meta_server","

 See http://www.sics.se/~joe/ubf/ for details of this service.
 See http://github.com/norton/ubf for source code
     extensions available as part of the larger OSS community.
 Type 'info'$ for information

"}$
'info'$
{"I am a meta server -

    type 'help'$

              ... to find out what I can do",'start'}$
'help'$
{1100~


This server speaks Universal Binary Format 1.0

                See http://www.sics.se/~joe/ubf.html
                See http://github.com/norton/ubf/tree/master for some
                source code extensions available as part of the larger
                OSS community.

UBF servers are introspective - which means the servers can describe
themselves. The following commands are always available:

'help'$          This information
'info'$          Short information about the current service
'description'$   Long information  about the current service
'services'$      A list of available services
'contract'$      Return the service contract
(Note this is encoded in UBF)

To start a service:

{'startSession', "Name", Arg}  Name should be one of the names in the
                                 services list.  Arg is an initial
argument for the Name service and is specific to that service; use
'foo' or # (the empty list) if the service ignores this argument.

Warning: Without reading the documentation you might find the output
from some of these commands difficult to understand :-)

~,'start'}$
'services'$
{#"file_server"&,'start'}$
{'startSession',"file_server",#}$
{{'ok',"I am a mini file server"},'start'}$
'ls'$
{{'files',#"Makefile"&"Unit-EUnit-Files"&"
Unit-Test-Files"&"contract_driver.erl"&"contract_lex.xrl"&"
contract_manager.erl"&"contract_manager_tlog.erl"&"
contract_parser.erl"&"contract_proto.erl"&"
contract_yecc.yrl"&"contracts.erl"&"contracts_abnf.erl"&"
ebf.erl"&"ebf_driver.erl"&"proc_socket_server.erl"&"
proc_utils.erl"&"ubf.erl"&"ubf_client.erl"&"
ubf_driver.erl"&"ubf_plugin_handler.erl"&"
ubf_plugin_meta.con"&"ubf_plugin_meta_stateful.con"&"
ubf_plugin_meta_stateful.erl"&"
ubf_plugin_meta_stateless.con"&"
ubf_plugin_meta_stateless.erl"&"ubf_plugin_stateful.erl"&"
ubf_plugin_stateless.erl"&"ubf_server.erl"&"ubf_utils.erl"&"
contract_lex.erl"&"contract_yecc.erl"&"erl_crash.dump"&"
check.log.20100708"&},'start'}$

となって正しく動いていることがわかります(画面の都合上適宜改行を入れています).次は中身の解析に進みます.

デプロイツールの再発明

はじめに

世の中にはEURO 2016 NewsとかArcher - yet another deployment tool - metacpan.orgなんていうデプロイツールがあって,普段はこれらを使っています.でも,新規サーバにインストールしないといけないことがたびたび起きて,それが面倒だなと思っていました.ファイルを一個だけ入れれば,ライブラリを追加しなくてもさくっと使えるデプロイツールがないものか,探すのに飽きたので作ってみました.

使い方

使い方は

$ ./pawn.pl -h
Usage: pawn.pl [options] File

Optons:
  -h,--help       this message
  -s,--shell      simple shell

で,引数として渡すファイルにDSLでターゲットホストと実行するコマンドを記述します.

hosts 'idc1-web-0001 idc1-web-0002';
commands sub {
    (
        [ 'hostname' => sub { print shift } ],
        [ 'date'     => sub { print shift } ]
    );
};

この場合,idc1-web-0001, idc1-web-0002というホストに対して,hostnameとdateコマンドを実行します.コマンド実行結果は画面に表示することになります.

$ ./pawn.pl sample
idc1-web-0001.foo.co.jp
2010722日 木曜日 18:59:00 JST
idc1-web-0002.foo.co.jp
2010722日 木曜日 18:59:02 JST

このファイルにsampleという名前を付けて,実行すると

$ ./pawn.pl -s sample
Pawn> uptime
idc1-web-0001>  18:44:19 up 100 days,  3:56,  0 users,  load average: 1.63, 1.55, 1.48
idc1-web-0002>  18:44:21 up 100 days,  3:13,  0 users,  load average: 1.20, 1.27, 1.35
Pawn> ^C

という出力がでます.できることは単純だけど,簡単な調査をするには便利なツールにしようと思っています.

スクリプト

現状はこんなスクリプトです.parallel forkする機能はまだ作っていません.もう少し作り込んだらgithubに上げるかもしれないですGitHub - daiba/Pawn: Yet another deploy toolにあげました.

#!/usr/bin/env perl
package App::Pawn::script;
use Getopt::Long;
use Term::ReadLine;
use strict;

sub new {
    my $class = shift;
    bless {
        argv => [],
        @_,
    }, $class;
}

sub parse_options {
    my $self = shift;
    local @ARGV = @{ $self->{argv} };
    push @ARGV, @_;

    Getopt::Long::Configure("bundling");
    Getopt::Long::GetOptions(
        's|shell'  => \$self->{shell},
        'h|help'   => sub { $self->help; exit },
    );
    $self->{argv} = \@ARGV;
}

sub help {
    my $self = shift;
    print <<HELP;
Usage: pawn.pl [options] File

Optons:
  -h,--help       this message
  -s,--shell      simple shell
HELP
}

sub load_file {
    my $self = shift;
    my $file   = shift @{$self->{argv}};
    my @attr   = qw( hosts commands );
    my $config = { file => $file };

    my $dsl = join "\n",
      map "sub $_ {my \$e=shift || return \$config->{$_}; \$config->{$_}=\$e }",
      @attr;
    $dsl .= <<DSL;

sub include {
    my \$b = shift || return;
    my \$f = dirname(\$self->{file}) . '/' . \$b;
    unless ( do \$f ) { die "can't include \$f\\n" }
}
DSL

    my $code = do { open my $io, "<", $file; local $/; <$io> };
    eval "package App::Pawn::Rule;\n"
      . "use File::Basename;\nuse strict;\nuse utf8;\n$dsl\n$code";
    die $@ if ($@);
}

sub loop {
    my $self = shift;
    if ( $self->{shell} ) {
        $self->shell;
    }
    else {
        $self->exec;
    }
}

sub shell {
    my $self  = shift;
    my @hosts = split /\s+/, App::Pawn::Rule::hosts();
    my $term  = Term::ReadLine->new('Pawn');
    my $out   = $term->OUT || \*STDOUT;
    while ( defined( my $line = $term->readline('Pawn> ') ) ) {
        next if $line =~ /^\s*$/;
        for my $host (@hosts) {
            next unless ($host);
            my $fd;
            open $fd, '-|', "ssh $host $line 2> /dev/null";
            my $output;
            {
                local $/ = undef;
                $output = <$fd>;
            }
            close $fd;
            printf $out "%s> %s", $host, $output;
        }
    }
}

sub exec {
    my $self = shift;
    my @hosts = split /\s+/, App::Pawn::Rule::hosts();
    my %ret;
    for my $host (@hosts) {
        next unless ($host);
        my $fd;
        my @doChecks = App::Pawn::Rule::commands()->();
        for my $doCheck (@doChecks) {
            my $do    = $$doCheck[0];
            my $check = $$doCheck[1];
            open $fd, '-|', "ssh $host $do 2> /dev/null";
            my $output;
            {
                local $/ = undef;
                $output = <$fd>;
            }
            $check->($output);
            close $fd;
        }
    }
}

sub doit {
    my $self = shift;
    $self->load_file;
    $self->loop;
}

package main;

unless (caller) {
    my $app = App::Pawn::script->new;
    $app->parse_options(@ARGV);
    $app->doit;
}

sshトンネリングしてる環境で,ssh先のホストが起動してないときにだんまりになる現象が起きてるので,異常系を作り込まないといけなさそうです.

おわりに

宮川さんのcpanm(のちょっと前のバージョン)を見ながら,こんな風に書けるんだと,思いながら作っています.すごいもんですね.

ここはだれ,わたしはどこ

geolocationでdebug

ロケタッチ、サービス終了のお知らせ : ロケタッチおしらせブログとか位置情報を使ったwebサービスが色々でてきました.自分でも何か作ってみようかと思って,ふと気づいたのが,

位置をデバッグするのはどうやるんだろう

ということでした.firefox3だと位置情報を拾えるので探してみた所,http://pugio.net/2009/07/fake-your-geolocation-in-firef.htmlというページを見つけました.

やること

まずデータファイルを作ります.例えば/Users/daiba/.mynewlocation.txtというファイルを開いて,

{"location":{"latitude":35.685675,"longitude":139.753475, "accuracy":20.0}}

と書きます.上記は皇居の場合の例です.このファイルは

file:///Users/daiba/.mynewlocation.txt

というURIを持ちます.次にfirefoxのabout:configで

geo.wifi.url

キーの値を編集します.標準値は

https://www.google.com/loc/json

となっていますが,これを上記のURIに変更します.about:configの編集に失敗すると,firefoxが正常に動作しなくなるので十分気をつけてください.

確認方法

グーグルマップスのページを開いて「現在地を表示する」ボタンを押してみましょう.そこで,指定した緯度経度情報を中心にした地図が表示できれば,設定は完了です.