わいえむねっと

PDF の仕様について

• クロスリファレンステーブル
• ファイルトレーラ

暗号化ついて

格納する情報について

スクリプト

use strict;
use warnings;
use Crypt::RC4;
use Digest::MD5;
use Encode;
use JSON;
use LWP::UserAgent;

undef $/;

my $pass = '';
my $url = 'http://www.oreilly.co.jp/books/%s/biblio.json';

my $ua = LWP::UserAgent->new;

while(<*.pdf>)
{
    next unless /-(\d{13})/;
    my $bookinfo = get_bookinfo($1);

    open my $in, $_ or die;
    open my $out, '>', $bookinfo->{title}.'.pdf' or die;
    binmode $in;
    binmode $out;

    $_ = <$in>;
    my $len = length;

    my($owner, $perm, $trailer, $prev);
    $owner   = $1 while /\/O\s*\((.+?)\)/gs;
    $perm    = $1 while /\/P\s+(-?\d+)/g;
    $trailer = $1 while /(trailer\n<<.+?>>)/gs;
    $prev    = $1 while /startxref\n(\d+)/g;
    die unless $trailer;
    die unless $prev;
    die unless $owner;
    die unless $perm;

    $trailer =~ /<(.+?)>/;
    my $id = $1;
    $trailer =~ /\/Size (\d+)/;
    my $info = $1;

    my $filekey = generate_filekey($pass, $owner, $perm, $id);
    my $key = generate_key($filekey, $info, 0);

    my $title  = RC4($key, $bookinfo->{original});
    my $author = RC4($key, $bookinfo->{authors});
    escape($title);
    escape($author);

    my $obj = <<EOS;
$info 0 obj
<<
/Title ($title)
/Author ($author)
>>
endobj
EOS

    my $size = $info + 1;
    $trailer =~ s/(\/Size\s+)\d+/$1$size/;
    $trailer =~ s/(>>)/\/Prev $prev \/Info $info 0 R $1/;

    my $offset = sprintf '%010d', $len;
    my $startxref = $len + length $obj;
    my $xref = <<EOS;
xref
$info 1
$offset 00000 n

$trailer
startxref
$startxref
%%EOF
EOS

    print $out $_;
    print $out $obj;
    print $out $xref;
}

sub get_bookinfo
{
    my $req = HTTP::Request->new(GET => sprintf $url, $1);
    my $res = $ua->request($req);
    $res->is_success or die $res->status_line;

    my $bookinfo = decode_json $res->content;

    exists $bookinfo->{title} or die;
    exists $bookinfo->{authors} or die;
    exists $bookinfo->{original} or die;

    $bookinfo->{title} =~ s/[:\/\\]/ /g;
    $bookinfo->{title} =~ s/\s+/ /g;
    utf8::encode $bookinfo->{title};
    Encode::from_to $bookinfo->{title}, 'utf8', 'shiftjis';

    my @authors;
    foreach(@{$bookinfo->{authors}})
    {
        foreach(split /\,/, $_)
        {
            next unless /[a-zA-Z]/;
            s/[^\x20-\x7E]//g;
            s/^\s*(.*?)\s*$/$1/;
            push @authors, $_;
        }
    }
    $bookinfo->{authors} = join ', ', @authors;

    $bookinfo->{original} =~ s/[^\x20-\x7E]+//g;

    return $bookinfo;
}

sub generate_filekey
{
    my $pad = pack 'H*',
        '28BF4E5E4E758A4164004E56FFFA0108'.
        '2E2E00B6D0683E802F0CA9FE6453697A';

    my $md5 = Digest::MD5->new;
    $md5->add(substr $_[0].$pad, 0, 32);
    $md5->add($_[1]);
    $md5->add(pack 'V', $_[2]);
    $md5->add(pack 'H*', $_[3]);
    substr $md5->digest, 0, 5;
}

sub generate_key
{
    my $md5 = Digest::MD5->new;
    $md5->add($_[0]);
    $md5->add(substr pack('V', $_[1]), 0, 3);
    $md5->add(substr pack('V', $_[2]), 0, 2);
    substr $md5->digest, 0, 10;
}

sub escape
{
    $_[0] =~ s/\\/\\\\/g;
    $_[0] =~ s/\n/\\n/g;
    $_[0] =~ s/\r/\\r/g;
    $_[0] =~ s/\t/\\t/g;
    $_[0] =~ s/\f/\\f/g;
    $_[0] =~ s/\(/\\(/g;
    $_[0] =~ s/\)/\\)/g;
}

おおまかな処理の流れ

1. ファイル名からISBNを抽出し、書籍情報を取得
2. ファイルから更新内容の追加に必要な情報を抽出
3. メタデータオブジェクトを作成して、暗号化した書籍情報を格納
4. クロスリファレンステーブルとファイルトレーラを作成
5. 書籍名でファイルを複製
6. メタデータを追加

実行結果

既知の問題とか制限事項とか

• 既存のメタデータがある場合を考慮していない
• /O や /P の検索がいい加減

• 追加データの /ID を更新していない
• 暗号化時に「Adobe Reader が誤認しなさそうな結果が得られるまで、シードを変えて繰り返す」とかいう日和ったことをしている

• 全角文字は非対応

雑感

2011/04/03 04:54:00

スクリプト

use strict;
use warnings;

# left, bottom, right, top
my @offset = (20, 20, -20, -20);

while(<*.pdf>)
{
    next if /-cropped/;

    open my $in, $_ or die;
    s/(.*)(\.pdf)$/$1-cropped$2/;
    open my $out, '>', $_ or die;

    binmode $in;
    binmode $out;

    while(<$in>)
    {
        s/(\/CropBox\s*\[\s*([^\[]+)\])/crop($1, $2)/eg;
        print $out $_;
    }
}

sub crop
{
    my @offset = @offset;
    my @pos = map{int $_ + shift @offset} split /\s+/, $_[1];

    my $crop = sprintf '/CropBox[%d %d %d %d]', @pos;

    my $blank = length($_[0]) - length $crop;
    warn $_[0] and return $_[0] if $blank < 0;

    return $crop.(' ' x $blank);
}

実行結果

CropBox 変更前

CropBox 変更後

味噌

/CropBox [ 0 0 516 659.52 ]

/CropBox [ 20 20 496 639.52 ]

2011/03/30 02:42:41