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 -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 StoreでCodeToGoというアプリを見つけて,もしかしたらニーズもあるかもしれないと思うようになりました.ビジネスモデルは(苦手だから)後回しにして,とりあえず動きそうなアーキテクチャを考えてみることにしました.
構想
アーキテクチャに名前がないと説明しにくいので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を使えばできそうだと考えましたが,FreeBSDとLinuxでは使い方が違うし,Linuxでもi386とx86_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を探して,見つかったらプロセスを止めればいいのかなと思っています.
今後の課題
- 疑問:レジスタの使い方は何をみればいいんだろう.i386とx86_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 +0900UBF 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 2010年 7月 22日 木曜日 18:59:00 JST idc1-web-0002.foo.co.jp 2010年 7月 22日 木曜日 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
キーの値を編集します.標準値は
となっていますが,これを上記のURIに変更します.about:configの編集に失敗すると,firefoxが正常に動作しなくなるので十分気をつけてください.
確認方法
グーグルマップスのページを開いて「現在地を表示する」ボタンを押してみましょう.そこで,指定した緯度経度情報を中心にした地図が表示できれば,設定は完了です.