どんなことでも

この人 blog を書くのだろうか？

マニュアルを読んで再挑戦 (PGP を perl で)

2007-12-19 04:13:13 | perl
祝1000! え？何かって？ これが、記事番号 1000個目なのです。去年の 1月からなので、2年で 1000件。結構書きましたねぇ。
で、余計なことは置いておいて以下本文。

Crypt::OpenPGP のマニュアルを読んでみると Crypt::OpenPGP で慣用暗号化方式の暗号化が出来るらしい事が発覚。CPAN で、「PGP symmetric」で検索したのが仇か？
「Crypt::OpenPGP::Cipher - PGP symmetric cipher factory」ってあったら、こっちを使おうとするのが心情というものではないか。
#!/usr/bin/perl -w
use lib qw(...);

use strict;
# use diagnostics;
# use warnings;
use Carp::Clan qw(verbose);
use Crypt::OpenPGP;

my $password = "Xevious";
my $cipher = "Twofish";

my $orig_file = "$ENV{HOME}/file";
my $enc_file = "$ENV{HOME}/file.enc";

my $pgp = Crypt::OpenPGP->new;
my $ciphertext = $pgp->encrypt(
Filename => $orig_file,
Passphrase => $password,
Cipher => $cipher,
Compress => "ZIP",
Armour => 1,
);

open ENC_FILE, ">$enc_file";
print ENC_FILE $ciphertext;
close ENC_FILE;
で、実行すると、
> ./test_pgp.pl
Use of uninitialized value in concatenation (.) or
string at $HOME/opt/perl/lib/perl5/site_perl/5.8.5/
Crypt/OpenPGP/SKSessionKey.pm line 31.
なんか、ワーニングが出ているのですがきちんと暗号化したファイルは作成されています。で、保存したファイルをデコードさせると
> gpg -o - ~/file.enc
gpg: TWOFISH暗号化済みデータ
gpg: 1 個のパスフレーズで暗号化
gpg: 警告: メッセージの完全性は保護されていません
dummy data
デコードできたけど perl のワーニングと、GPG に「警告: メッセージの完全性は保護されていません」と言われるのは気に食わん。
さて、どうしたものか。「-w」を外せ？ごもっとも。でもそれは対処療法かと。

PGP を perl で

2007-12-18 18:53:12 | perl
また、perl ですよ。
ほんとに、MSX-BASIC をちょっと知ってるぐらいで perl をいじり初めて...
で「gpg -ca --cipher-algo TWOFISH」みたいなことを perl でしようと思い
#!/usr/bin/perl -w

use lib qw(...);

# use strict;
use Crypt::OpenPGP::Cipher;

my $orignal;
my $password = "Xevious";
my $algorithm = "Twofish";

# 「key must be 16, 24, or 32 bytes long at Crypt/Twofish.pm line 24.」
# なんて出るので、後ろに NULL をくっつけて 16 bit 単位に揃える。
my $align = 16;
my $length = int((length($password)+($align-1))/$align) * $align - length($password);
$password = $password . ("\000" x $length);

my $cipher = Crypt::OpenPGP::Cipher->new($algorithm,$password);

open BODY, "<$ENV{HOME}/file";
while (<BODY>){$orignal .= $_;}
close BODY;

my $encrepted = $cipher->encrypt($orignal);

open BODY, ">$ENV{HOME}/file.enc";
print BODY $encrepted;
close BODY;
かなり省略。でも、多分動く。
しかし、出来たファイルを gpg に食わせてみる。
> gpg -o - ~/file.enc
gpg: 有効なOpenPGPデータが見つかりません。
gpg: processing message failed: eof
Exit 2
デコードできず。
う～ん、どっか例が転がってないかなぁ。慣用暗号化ってので先ず敷居が上がるんだよねぇ。
大体、perl 自身で複合化できるかどうかを試していない時点で(^^; perl 自身で複合化できるのなら、pgp コマンドを使わずに perl コマンドで暗号化すれば良いとも言えなくもない。gpg コマンドに関わり合う必要は全くないか。
# でも、出来ないのは悔しい。

$this が undef

2007-12-18 13:22:42 | perl
さて、また perl
http://blog.livedoor.jp/jigorou/archives/640584.html
とか色々見ながら、パッケージというか、オブジェクト指向っぽいのを書いてみようかと思った。
で、以下。
#! /usr/bin/perl -Tw
use strict;
{
package test_pkg;
sub new{
my $this = shift;

my $data = {
"alpha" => "Alpha",
"beta" => "Beta"
};

return bless $data => $this;
}
}
my $obj_test_pkg = test_pkg::new();
これを動かすと、bless の引数の $this が undef だとエラーが出る。
第一引数には自動的にパッケージ名が入るのではないのか？とか思った。
で、最後の1行を
my $obj_test_pkg = test_pkg->new();
と書き換えてみた。動いた。う～ん、`::' と `->' は等価ではないのか。perl は謎が多いなぁ。

perl Expect

2007-12-13 22:07:26 | perl
perl の Expect を使ってみた。でも、動作ログが取れません。マニュアルのリファレンス部分には
$object->log_file("filename" | $filehandle | \&coderef | undef)
と書かれていて、ファイルハンドルを使えるように読める。だが、例の部分には
　1. ファイル名を直接渡す方法」
　3. 関数を呼ぶ方法
　4. 出力を解除する方法
が載っているが、
　2. ファイルハンドルを使う方法
だけ書かれていない。試しに書いてみると
#! /usr/bin/perl -Tw

use lib qw(...略...);

require 5.6.0;
use Expect;
use strict;

$ENV{PATH} = "/bin:/usr/bin";

# log ファイルを開く
open($main::LOG, '>', "log_log");
printf "ref \$main::LOG is %s\n", ref $main::LOG;

my $exp = Expect->spawn("ls", "-l") or die "Cannot spawn ls: $!\n";

# $exp->debug(3);
# $exp->exp_internal(1);
$exp->expect(3 , # timeout
[
qr/.*/s => sub {
$exp->log_file($main::LOG);
$exp->print_log_file("--- ls command. ---");
$exp->send("ls\n");
exp_continue;
}
],
[ timeout => sub { print "timeout?\n"; } ],
);
これを実行
> ./test
ref $main::LOG is GLOB
Given logfile doesn't have a 'print' method at ./test line 22
Exit 255
駄目じゃん。
ソースを見ると、ref($file) が 'CODE' だとファイルハンドルと認識するようだが、私のファイルハンドルは GLOB となっている。
う～ん、CODE って何？ GLOB って何？(「型グロブ」の「グロブ」？型グロブって何？) という状態で数時間固まっております。
さて、ファイル名を与えると正しく動くことは確認済みなんだが、どうするかなぁ。ファイルハンドルを持ち回した方が使いやすそうなのだが。
誰か教えて～。昔入っていた perl な ML が分からなくなってしまいました。

ファイル名とタイムスタンプ復旧

2006-06-23 07:05:21 | perl
以前フォルダーがぶっ飛んでしまいサルベージされたもののファイル名が「FILExxxxx」になったり、タイムスタンプがサルベージした時間に変わってしまったものを perl スクリプトを書いて復旧させてみました。Image::ExifTool 以外は標準モジュールです。
#! /usr/local/bin/perl -w
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
if 0; #$running_under_some_shell

use strict;
use File::Find qw();
use Time::Local;
use POSIX;

use Image::ExifTool 'ImageInfo';

sub Rename ($){
my $info = ImageInfo($_);
if (defined($$info{'DateTimeOriginal'})){
undef $$info{'ThumbnailImage'};

# 'DateTimeOriginal' => '2006:01:03 18:39:02'
$$info{'DateTimeOriginal'} =~ /^(\d{4}):(\d{2}):(\d{2}).(\d{2}):(\d{2}):(\d{2})$/;
my $ShotTime = timelocal($6, $5, $4, $3 , $2 - 1, $1 - 1900);
print "DateTimeOrignal: $$info{'DateTimeOriginal'}\n",
strftime("timestamp to: %F %T\n", $6, $5, $4, $3 , $2 - 1, $1 - 1900);
#--- utime $ShotTime, $ShotTime, $_;

# 'FileNumber' => '121-2187',
$$info{'FileNumber'} =~ /^\d{3}-(\d{4})$/;
print "$_ chenge to IMG_${1}.JPG\n";
#--- rename $_, "IMG_${1}.JPG";
}else{
print "$_: Can not found DateTimeOriginal. This file Skip!";
}
}

# Set the variable $File::Find::dont_use_nlink if you're using AFS,
# since AFS cheats.

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name = *File::Find::name;
*dir = *File::Find::dir;
*prune = *File::Find::prune;

sub wanted;


# Traverse desired filesystems
File::Find::find({wanted => \&wanted}, '.');
exit;


sub wanted {
# if(/^FILE.*\z/s) {
if(/^IMG_.*\z/s) {
printf("___ $name ___\n");
Rename ($name);
}
}
こんな感じ。
復旧させたファイルを適当に flickr へ載せてみました。