June 2008 Archives

*::Nowa をアップデートした

| 0 Comments | 0 TrackBacks

xcezx さんから、utf-8 フラグ周りで化けていると思われるバグの報告受けました。

encode_utf8 するオプションを追加して対策しました。

これはひどい。woremacx 自重。

Net::Amazon::S3 を Park Place のホストに使う

| 0 Comments | 0 TrackBacks

ローカルに建てた 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 );

Firestorage.jp を Perl スクリプトから使う

| 0 Comments | 0 TrackBacks

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 で AV 女優ブログの画像でハァハァする

| 0 Comments | 0 TrackBacks

PicLens がほんとすごい!

ぼくが PicLens を最初に知ったのは、june29 さんの TumbLensをHerokuにてリリース - cameraLady というエントリでした。june29 さんが、Tumblr を PicLens で見る TumbLens というサイトを作っのです。PicLens に感動するとともに、Tumblr を PicLens で見る発想に感動しました。


で、最近のぼくは、Flickr の新着ページ (Flickr: Photos & video from everyone in Flickr) を見るのに PicLens を使っていました。適当にカワイイ子が映っている写真を選んで、PicLens でひたすらその子が映ってる色々な写真を見るという使い方です。


そんな中、新たな PicLens サイトが現れました。

avmaster さんの AV女優ブログ検索 です。

AV女優ブログ検索運用日記 : Piclensを使って、スライドショーでみよう! - livedoor Blog(ブログ) で avmaster さんがエントリされているとおり、『女優さんの画像がスライドショーでみれる』のです!

画像集めてくるのめんどくせーなーと思ってたぼくにピッタリのサービスです!!


PicLens 対応のサービスがもっと増えるといいですね!

ciao!

なんか

| 0 Comments | 0 TrackBacks

優秀なハカーの皆さんならすでにご検討されたようなことなんでしょうけど、思いついたので一応書いておきますね。

DBIC って、redhat 系由来の遅くなるパッチの当たってる環境では、DBIC_NO_WARN_BAD_PERL=1 をつけないと STDERR にうざいメッセージを吐く機構が DBIx::Class::StartupCheck にあります。

それみたく、Catalyst では使っていいプラグインのホワイトリストを持っておいて、うざいメッセージを吐くだけじゃなくて CATALYST_ENABLE_BACKWARD_COMPATIBLE_PLUGIN=1 (英語適当) みたいなのをつけないと起動しない仕組みとか入れればいいんじゃないのかなと思いました。

perl-mongers.org の障害回復のお知らせ

| 0 Comments | 0 TrackBacks

こんにちは、woremacx です。

perl-mongers.org を含む、woremacx.com でホストしている全てのサービスがほぼ半日間(午前8時前から午後6時前くらいまで)アクセスできない状態となっておりました。

これまでは、アナウンスなしに突然繋がらなくなることが多々ありました。がしかし、現在は perl-mongers.org という公共性の高いサイトをホストしていることから、ご報告させていただくことにしました。

繋がらなくなっていた原因は、スイッチングハブの電源が抜けていたことです。単純ミスです。

perl-mongers.org をはじめ、woremacx.com でホストしている各種サービスをご利用のみなさまにご迷惑おかけしました。

今後とも、perl-mongers.org をよろしくお願いいたします!

父の日には新しい TENGA - TENGA フリップホール - を送ろう!

| 0 Comments | 0 TrackBacks

こんにちは。もう少しで父の日ですね!

こういうイベントって、何を送ろうか、毎年迷っちゃいますね。だけど今年は悩む必要なんて無いですよ!

そう。TENGA ですよ TENGA 。

今までの TENGA は使い捨てで不経済でしたが、今度の TENGA は「約50回の使用が可能。」だそうですよ!

お父さんきっと喜びますよ!

tenga.jpg
TENGA FLIP HOLE フリップホール
tenga
売り上げランキング: 384

今日の MTOS hacks!

| 0 Comments | 0 TrackBacks

今日は、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 にアップグレードしました。