xcezx さんから、utf-8 フラグ周りで化けていると思われるバグの報告受けました。
encode_utf8 するオプションを追加して対策しました。
これはひどい。woremacx 自重。
June 2008 Archives
ローカルに建てた Park Place で使いたかったので。
$ diff -u Net/Amazon/S3.pm.orig Net/Amazon/S3.pm --- Net/Amazon/S3.pm.orig 2008-03-27 17:40:40.000000000 +0900 +++ Net/Amazon/S3.pm 2008-06-18 05:10:04.323364757 +0900 @@ -110,7 +110,7 @@ use base qw(Class::Accessor::Fast); __PACKAGE__->mk_accessors( - qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout retry) + qw(libxml aws_access_key_id aws_secret_access_key secure ua err errstr timeout retry s3_host) ); our $VERSION = '0.44'; @@ -672,9 +672,10 @@ $self->_add_auth_header( $http_headers, $method, $path ) unless exists $headers->{Authorization}; my $protocol = $self->secure ? 'https' : 'http'; - my $url = "$protocol://s3.amazonaws.com/$path"; - if ( $path =~ m{^([^/?]+)(.*)} && _is_dns_bucket($1) ) { - $url = "$protocol://$1.s3.amazonaws.com$2"; + my $host = $self->s3_host || "s3.amazonaws.com"; + my $url = "$protocol://$host/$path"; + if ( !$self->s3_host && $path =~ m{^([^/?]+)(.*)} && _is_dns_bucket($1) ) { + $url = "$protocol://$1.$host$2"; } my $request = HTTP::Request->new( $method, $url, $http_headers );
LWP::UserAgent をつかってファイルをアップロードしてみましたよ！
コマンドラインからサクっと使えて便利ですよ！
あと、人には絶対見られたくない恥ずかしい写真とか動画とか送るとき用に、AES かけれるようにしてみたよ！
一時ファイルを作らずに、AES で暗号化しながらアップロード、ダウンロードしながら AES で解読とかしてみました。
どう考えても汚い書き方なので、なんかもっとキレイかつ楽ちんに書ける方法あったらおしえてください。
ふつうに使う
firestorage-put.pl
usage: # 2 つめのパラメータは省略可 $ firestorage-put.pl "/path/to/your/file.avi" label.avi
#!/usr/bin/perl use strict; use HTTP::Request::Common; use LWP::UserAgent (); { sub HTTP::Request::Common::boundary { my @chr = ('A' .. 'Z', 'a' .. 'z', '0' .. '9'); my @buf; push(@buf, $chr[int(rand(@chr))]) for (1..30); return '-' x 10 . join(q{}, @buf); } } sub upload { my $filebody = shift; my $filename = shift || $filebody; local $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1; my $ua = LWP::UserAgent->new(agent => "Shockwave Flash"); my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); my $id = sprintf("%4d%02d%02d%02d%02d%02d%d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $$); my $exp = 7; my $url = "http://firestorage.jp/upload.cgi"; my $res = $ua->post($url, Content_Type => 'form-data', Content => [ Filename => $filename, processid => $id, exp => $exp, Filedata => [$filebody, $filename], Upload => "Submit Query", ]); if ($res->content =~ m!(http://firestorage.jp/download/\w+)!s) { return $1; } undef; } die unless @ARGV; my $res = upload(@ARGV); print $res ? $res : "failed"; print "\n";
AES で暗号化しながらつかう
usage: $ dd if=/dev/zero of=2048 bs=2048 count=1 1+0 records in 1+0 records out 2048 bytes (2.0 kB) copied, 0.0172761 s, 119 kB/s $ perl firestorage-aes-put.pl 2048 url: http://firestorage.jp/download/c56e... key: 88c0f6d8a4e6aca71ccee0b2b022bf0c $ perl firestorage-aes-get.pl http://firestorage.jp/download/c56e... AES key: (キー 88c0f6d8a4e6aca71ccee0b2b022bf0c を入力) saving 2048 ...done
firestorage-aes-put.pl
#!/usr/bin/perl use strict; use HTTP::Request::Common; use LWP::UserAgent (); use Crypt::CBC; use Digest::MD5; { sub HTTP::Request::Common::boundary { my @chr = ('A' .. 'Z', 'a' .. 'z', '0' .. '9'); my @buf; push(@buf, $chr[int(rand(@chr))]) for (1..30); return '-' x 10 . join(q{}, @buf); } } sub upload { my $filebody = shift; my $filename = shift || $filebody; local $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1; my $ua = LWP::UserAgent->new(agent => "Shockwave Flash"); my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); my $id = sprintf("%4d%02d%02d%02d%02d%02d%d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec, $$); my $exp = 7; require HTTP::Request::Common; my $url = "http://firestorage.jp/upload.cgi"; my $request = HTTP::Request::Common::POST($url, Content_Type => 'form-data', Content => [ Filename => $filename, processid => $id, exp => $exp, Filedata => [$filebody, $filename], Upload => "Submit Query", ]); my $code = $request->{_content}; my $in_cd = 0; my $cb_looping; my $md5_inst; my $crypt_inst; my $len = $request->header('Content-Length'); my $file_len = -s $filebody; my $new_len = $file_len + ($file_len % 16 ? 16 - $file_len % 16 : 16); $len += $new_len - $file_len; $request->header('Content-Length', $len); my $key; $request->{_content} = sub { my $coderes = $code->(); unless ($cb_looping) { if ($coderes =~ /^(.*?)\015\012/) { $cb_looping = $1; } } my $payload; my $finish = 0; my $header_of_payload; if (!$in_cd && $coderes =~ /^Content-Disposition[^\012]+?; filename=/) { $in_cd++; my $loc = index($coderes, "\015\012\015\012"); $header_of_payload = substr($coderes, 0, $loc + 4); $payload = substr($coderes, $loc + 4); } elsif ($in_cd && $coderes =~ /$cb_looping/) { $in_cd = 0; $finish++; } elsif ($in_cd) { $payload = $coderes; } if (length($payload)) { unless($md5_inst) { $key = Digest::MD5->md5_hex(time().$$.$payload); $crypt_inst = Crypt::CBC->new({ key => $key, cipher => 'Rijndael', iv => Digest::MD5->md5('woremacx'), regenerate_key => 0, padding => 'standard', prepend_iv => 0, }); $crypt_inst->start('encrypt'); $md5_inst = Digest::MD5->new; } $md5_inst->add($payload); $coderes = $crypt_inst->crypt($payload); if (length($header_of_payload)) { $coderes = $header_of_payload . $coderes; } } if ($finish) { # warn $md5_inst->hexdigest; my $left = $crypt_inst->finish; $coderes = $left . $coderes; $finish = 0; } $coderes; }; my $res = $ua->request($request); if ($res->content =~ m!(http://firestorage.jp/download/\w+)!s) { return "url: $1\nkey: $key"; } undef; } die unless @ARGV; my $res = upload(@ARGV); print $res ? $res : "failed"; print "\n";
firestorage-aes-get.pl
#!/usr/bin/perl use strict; use LWP::UserAgent; use Digest::MD5; use Crypt::CBC; my $ua = LWP::UserAgent->new; for my $url (@ARGV) { my $res = $ua->get($url); my $content = $res->content; while ($content =~ m!"(http://\w+\.firestorage\.jp/download[^\"]+?act=download_file[^\"]+)".*?>(.*?)</a>!g) { my ($url, $saveto) = ($1, $2); unless (-e $saveto) { my $key = get_key(); # warn $key; my $cipher = Crypt::CBC->new({ key => $key, cipher => 'Rijndael', iv => Digest::MD5->md5('woremacx'), regenerate_key => 0, padding => 'standard', prepend_iv => 0, }) or die; $cipher->start('decrypt'); open(my $fh, "> $saveto"); my $total_len; my $recieved; my $decrypt = sub { my ($payload, $pp, $qq) = @_; $total_len ||= $pp->{_headers}->{'content-length'}; $recieved += length($payload); print $fh $cipher->crypt($payload); if ($total_len == $recieved) { print $fh $cipher->finish; } }; print "saving $saveto ..."; $ua->get($url, ':content_cb' => $decrypt); close($fh); print "done\n"; } else { print "$saveto already exists\n"; } } } sub get_key { local($|) = 1; local(*TTY); open(TTY,"/dev/tty"); my ($key1,$key2); system "stty -echo </dev/tty"; do { print STDERR "AES key: "; chomp($key1 = <TTY>); } until $key1 =~ /^[a-f0-9]{32}$/; system "stty echo </dev/tty"; close(TTY); $key1; }
PicLens がほんとすごい！
ぼくが PicLens を最初に知ったのは、june29 さんの TumbLensをHerokuにてリリース - cameraLady というエントリでした。june29 さんが、Tumblr を PicLens で見る TumbLens というサイトを作っのです。PicLens に感動するとともに、Tumblr を PicLens で見る発想に感動しました。
で、最近のぼくは、Flickr の新着ページ (Flickr: Photos & video from everyone in Flickr) を見るのに PicLens を使っていました。適当にカワイイ子が映っている写真を選んで、PicLens でひたすらその子が映ってる色々な写真を見るという使い方です。
そんな中、新たな PicLens サイトが現れました。
AV女優ブログ検索運用日記 : Piclensを使って、スライドショーでみよう！ - livedoor Blog（ブログ） で avmaster さんがエントリされているとおり、『女優さんの画像がスライドショーでみれる』のです！
画像集めてくるのめんどくせーなーと思ってたぼくにピッタリのサービスです！！
PicLens 対応のサービスがもっと増えるといいですね！
ciao!
優秀なハカーの皆さんならすでにご検討されたようなことなんでしょうけど、思いついたので一応書いておきますね。
DBIC って、redhat 系由来の遅くなるパッチの当たってる環境では、DBIC_NO_WARN_BAD_PERL=1 をつけないと STDERR にうざいメッセージを吐く機構が DBIx::Class::StartupCheck にあります。
それみたく、Catalyst では使っていいプラグインのホワイトリストを持っておいて、うざいメッセージを吐くだけじゃなくて CATALYST_ENABLE_BACKWARD_COMPATIBLE_PLUGIN=1 (英語適当) みたいなのをつけないと起動しない仕組みとか入れればいいんじゃないのかなと思いました。
こんにちは、woremacx です。
perl-mongers.org を含む、woremacx.com でホストしている全てのサービスがほぼ半日間(午前8時前から午後6時前くらいまで)アクセスできない状態となっておりました。
これまでは、アナウンスなしに突然繋がらなくなることが多々ありました。がしかし、現在は perl-mongers.org という公共性の高いサイトをホストしていることから、ご報告させていただくことにしました。
繋がらなくなっていた原因は、スイッチングハブの電源が抜けていたことです。単純ミスです。
perl-mongers.org をはじめ、woremacx.com でホストしている各種サービスをご利用のみなさまにご迷惑おかけしました。
今後とも、perl-mongers.org をよろしくお願いいたします！
こんにちは。もう少しで父の日ですね！
こういうイベントって、何を送ろうか、毎年迷っちゃいますね。だけど今年は悩む必要なんて無いですよ！
そう。TENGA ですよ TENGA 。
今までの TENGA は使い捨てで不経済でしたが、今度の TENGA は「約50回の使用が可能。」だそうですよ！
お父さんきっと喜びますよ！
今日は、perl-mongers.org の微調整 hack を行いました。
- convert lines break で <pre> を書いた場合に、シンタックスハイライトされるように変更しました。
- Text::Hatena でシンタックスハイライトの方法を、vimcolor から google-code-prettify へ変更しました。mattn さんのエントリ(Text::Vim-Colorを使えなくてもText::HatenaでSuperPreを使う - perl-mongers.org)が大変参考になりました。ありがとうございます。
- Text::Hatena の AA 記法に対応しました。
ということで、perl-mongers.org をよろしくおねがいします！
- yusukebe さんが、著者のアイコンを表示するようにしてくれました! nick work!
- MT::Auth::OpenID にもともと入っていた、アイコンを取ってくるコードを復活させました。
- MTOS-4.2rc1-en にアップグレードしました。
