2008/04/02


ただいま、JavaとCOMを使ったお仕事をしているんですが、どうも正常に動かないものがありまして、困っておりました。

どんな現象かといいますと、Microsoft AgentをAgentObjectsから起動した時に、ConnectedというBOOL型のプロパティをTRUEに設定してやるのですが、どうやらJavaから渡していた値trueが、VARIANT変換により1になっていた事が原因していました。

まぁ、1だしfalseじゃないなら動作するのが一般的なアプリでしょ...と思ってましたが、どっこいMSAgent殿は例外も出さずにConnectedをFALSEに設定して下さいました。

実際、COM上ではBOOLはVARIANT_TRUEもしくはVARIANT_FALSEを設定するのがお決まりで、VARIANT_TRUEは ((VARIANT_BOOL)0xffff)
 と宣言されていました。C++上でのtrueとは値が異なる訳です。

まぁ、それは自分のミスとして...

きっとMSAgentのConnectedプロパティ処理では
if (VARIANT_TRUE == arg) {
  // Connected 設定時の処理...
}
 というコードが書かれているのだと思うのですが、これは if (VARIANT_FALSE != arg) {
  // Connected 設定時の処理...
}
 って書くべきなんじゃないかな...

ちなみに、Visual Studioのウォッチエリアに追加した、1の値を持つ問題のVARIANT変数は、VT_BOOL:Trueと表示されていました。
Posted at by



2008/04/01


以前、miyagawa氏作のXML::Atom::ServerをベースとしてXSをなるべく使わない「XML::Atom::Server::Lite」というのを作ってCodeReposに放置していたのですが、そろそろ放置しすぎな感もあったので発作的にエントリ。
「XML::Atom::Server::Lite」は「XML::Atom::Server」と構造をほぼ同じにしてあり、中で使用しているXML::Atomを自前のXSを使わないクラスで置き換えてしまおうというモジュールです。
LibXMLが使えないサーバには、もしかしたら有用かもしれません。サーバ用途だけならばLWPも使いませんし、簡単に低コストでAtom::Serverが実現出来ると思います。
「Digest::SHA」も「Digest::SHA::PurePerl」で置き換えています。
今日はこの「XML::Atom::Server::Lite」を使ってblosxomのAtom::Serverを作ってみました。
ソースは以下の通り。
#!/usr/bin/perl

package Blosxom::AtomPP;
use strict;
use base qw( XML::Atom::Server::Lite );
use File::Find;
use File::stat;

if (-e "/path/to/blosxom/config/file/config.cgi") {
    package blosxom;
    require '/path/to/blosxom/config/file/config.cgi';
}

my %Passwords = (
    yourname => 'yourpassword',
);
my $postsWanted = 10;

sub password_for_user {
    my $server = shift;
    my($username) = @_;
    $Passwords{$username};
}

sub getFilenameFromPostId {
  my $postid = shift @_;
  unless ( $postid =~ /$blosxom::datadir/ ) {
    if ( $postid =~ m!^/! ) {
      #Post ID now has a preceeding /
      $postid = $blosxom::datadir . $postid;
    } else {
      $postid = "$blosxom::datadir/$postid";
    }
  }
  return $postid;
}

sub getRandomFilename {
  my $time = time;
  $time .= int( rand(10) );
  $time .= int( rand(10) );
  return $time;
}

sub decode_html {
    my $str = shift @_;
    $str =~ s/&#([0-9]+);/chr($1)/ge;
    $str =~ s/&#[xX]([0-9A-Fa-f]+);/chr(hex $1)/ge;
    $str =~ s!\x0D|\x0A!<br />\n!g;
    $str =~ s/\&gt;/>/g;
    $str =~ s/\&lt;/</g;
    $str =~ s/\&quot;/"/g;
    $str =~ s/\&amp;/\&/g;
    return $str;
}

sub getPost {
    my $filename  = shift @_;
    my $start     = shift @_ || $blosxom::datadir;
    my $extension = shift @_ || $blosxom::file_extension;

    if ( -e $filename ) {
        open POST, "$filename";
        my @post = <POST>;
        close POST;
        my %struct;
        $struct{'postid'}      = $filename;
        $struct{'dateCreated'} = File::stat::stat($filename)->mtime;
        my $title              = shift @post;
        $title                 =~ s!\x0D|\x0A!!g;
        $struct{'title'}       = $title;
        foreach (@post) {
            my $line = $_;
            if ( !$struct{'subject'} && $line =~ /^meta-tags: (.*)$/ ) {
                $line = $1;
                $line =~ s!\x0D|\x0A!!g;
                my @subjects = split(/\s*,\s*/, $line);
                $struct{'subject'} = \@subjects;
            } else {
                $struct{'description'} .= $line;
            }
        }
        my @cats;
        $filename =~ s/$start(\/.*)\/.*$extension$/$1/ or $filename = "/";
        push @cats, $filename;
        $struct{'categories'} = \@cats;
        return \%struct;
    }
    else {
        return 0;
    }
}

sub newPost {
    my $struct    = shift @_;
    my $start     = shift @_ || $blosxom::datadir;
    my $extension = shift @_ || $blosxom::file_extension;

    my $filename;

    if ( defined( $struct->{'postid'} ) ) {
        $filename = getFilenameFromPostId( $struct->{'postid'} );
    }
    else {
        $filename = lc( $struct->{'title'} );
        $filename =~ s/\W+/_/g;
        $filename =~ s/_+$//;
        $filename = getRandomFilename() unless $filename =~ m/[a-z]/;
        if ( $struct->{'categories'} ) {
            $filename =
              "$start/$struct->{'categories'}[0]/$filename.$extension";
        }
        else {
            $filename = "$start/$filename.$extension";
        }
    }

    chomp $struct->{'title'};
    chomp $struct->{'description'};

    unless ( -e $filename ) {
        open POST, ">$filename.old" or die "Can't Open File $filename: $!";
        print POST decode_html($struct->{'title'})."\n";
        print POST decode_html($struct->{'description'})."\n";
        close POST;
        my $files = chmod 0664, $filename;
    }
    return $filename;
}

sub getEntry {
    my $filename = shift;
    my $post = getPost( $filename );
    return unless $post;

    my $entry = XML::Atom::Server::Lite::Entry->new;
    my $extension = $blosxom::file_extension;

    $entry->title($post->{title});

    my $url = $blosxom::url.$post->{'postid'};
    $url =~ s/$extension$/htm/;
    $entry->link({
            type=>'text/html',
            rel=>'alternate',
            href=>$url,
    });

    $entry->content({
            mode=>'xml',
            type=>'xhtml',
            body=>$post->{description},
    });

    for my $cat (@{$post->{categories}}) {
        $entry->category({
                term=>$cat,
                label=>$cat,
        });
    }
    $entry->subject(@{$post->{subject}});
    return $entry;
}

sub handle_request {
    my $server = shift;
    my $method = $server->request_method;
    $server->authenticate or return;
    if ($method eq 'POST') {
        return $server->new_post;
    }
    $server->response_code(200);
    $server->response_content_type('application/x.atom+xml');

    my $start       = $blosxom::datadir;
    my $extension   = $blosxom::file_extension;
    my $url = $server->path_info;
    if ($url =~ /$blosxom::file_extension$/) {
         my $entry = getEntry( "$start/$url.old" );
        return $entry->as_xml;
    } else {
        my %posts;
        File::Find::find(
            sub {
                $File::Find::name =~ /$extension$/
                  ? $posts{$File::Find::name} =
                  File::stat::stat($File::Find::name)->mtime
                  : 0;
            },
            $start
        );
        my @postList = sort { $posts{$b} <=> $posts{$a} } keys %posts;
        if ( $#postList > $postsWanted ) {
            @postList = @postList[ 0 .. ( $postsWanted - 1 ) ];
        }
        my $feed = XML::Atom::Server::Lite::Feed->new;
        $feed->title($blosxom::blog_title);
        $feed->link({
            rel => 'self',
            type => 'application/atom+xml',
            title => $blosxom::blog_title,
            href => $server->uri,
        });
        $feed->link({
            rel => 'alternate',
            type => 'text/html',
            title => $blosxom::blog_title,
            href => $server->uri,
        });
        $feed->link({
            rel => 'service.post',
            type => 'application/x.atom+xml',
            title => $blosxom::blog_title,
            href => $server->uri,
        });
        for my $filename (@postList) {
            my $entry = getEntry( $filename );
            $feed->add_entry( $entry ) if $entry;
        }
        return $feed->as_xml;
    }
}

my %esc = (
    "\a" => "\\a",
    "\b" => "\\b",
    "\t" => "\\t",
    "\n" => "\\n",
    "\f" => "\\f",
    "\r" => "\\r",
    "\e" => "\\e",
);

sub qquote {
  local($_) = shift;
  s/([\\\"\@\$])/\\$1/g;
  my $bytes; { use bytes; $bytes = length }
  s/([^\x00-\x7f])/'\x{'.sprintf("%x",ord($1)).'}'/ge if $bytes > length;
  return qq("$_") unless
    /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;  # fast exit

  my $high = shift || "";
  s/([\a\b\t\n\f\r\e])/$esc{$1}/g;

  if (ord('^')==94)  { # ascii
    # no need for 3 digits in escape for these
    s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
    s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
    # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE--
    if ($high eq "iso8859") {
      s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
    } elsif ($high eq "utf8") {
#     use utf8;
#     $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
    } elsif ($high eq "8bit") {
        # leave it as it is
    } else {
      s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
      s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
    }
  }
  else { # ebcdic
      s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)}
       {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg;
      s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])}
       {'\\'.sprintf('%03o',ord($1))}eg;
  }

  return qq("$_");
}

sub get_content_node {
    my $tree = shift;
    if ($tree->{children} && (@{$tree->{children}} eq 1)
            && $tree->{children}->[0]->{name} eq 'content') {
        $tree = $tree->{children}->[0];
        for my $item (@{$tree->{children}}) {
            if ($item->{name} eq 'div' && $item->{attributes}
                && $item->{attributes}->{xmlns} =~ 'http://www.w3.org/1999/xhtml') {
                $tree = $item;
                for my $nobr (@{$tree->{children}}) {
                    return $nobr if $nobr->{name} ne 'br' && $nobr->{type} eq 'tag';
                }
                last;
            }
        }
    }
    $tree;
}

sub to_xml {
    my $tree = shift;
    my $xml;
    if ($tree->{name}) {
        $xml .= "<".$tree->{name};
        for my $attr (keys %{$tree->{attributes}}) {
            $xml .= " $attr=".qquote($tree->{attributes}->{$attr});
        }
    } elsif ($tree->{content}) {
        $xml .= $tree->{content};
    }
    if ($tree->{children}) {
        $xml .= ">" if $tree->{name};
        foreach my $item (@{$tree->{children}}) {
            $xml .= to_xml($item);
        }
        $xml .= "</".$tree->{name}.">" if $tree->{name};
    } elsif ($tree->{name}) {
        $xml .= "/>";
    }
    $xml;
}
sub new_post {
    my $server = shift;
    my $entry = $server->atom_body or return;

    my $struct = {};

    my $url = $server->path_info || $entry->link;
    $url =~ s/htm$/$blosxom::file_extension/;
    $struct->{postid} = $url;
    $struct->{title} = $entry->title;
    my $tree_parser = XML::Parser::Lite::Tree::instance();
    my $tree = $tree_parser->parse( $entry->content->body );
    my $data = to_xml(get_content_node($tree));
    $struct->{description} = $data;
    $struct->{categories} = $entry->{category};

    my $filename = newPost( $struct );
    my $created = getEntry( $filename );
    $server->response_code(201);
    $server->response_content_type('application/x.atom+xml');
    $server->response_header(Location => $server->uri.$struct->{postid});
    return $created;
}

package main;
my $server = Blosxom::AtomPP->new;
$server->run;
 厳密な「service.post」や「alternate」ではありませんが「XML::Atom::Server::Lite」の検証としてはこの程度で十分かなと思ってます。ポストも出来ます(認証はWSSE)。
Zoundry Ravenというブログツールでは動作を確認しました。
zoundry-raven

おそらくですが
  • 「XML::Atom::Server::Lite」を「XML::Atom::Server」
  • 「XML::Atom::Server::Lite::Feed」を「XML::Atom::Feed」に
  • 「XML::Atom::Server::Lite::Entry」を「XML::Atom::Entry」に
戻せば、そのまま動くかと思います。
なお、「XML::Atom::Server::Lite」はSOAPには対応していません。馬力のある方は適当に弄って下さい。

これでblosxomにXMLRPCとAtomのインタフェースが揃った事になるのかな？
Posted at by



2008/03/31


コンパイルは通るだろうけど、ちょっと本文から直してほしいですね。影響力のある場所でしかも「推薦する」なんてリンクが付いている状態で放置は間違いを広めてしまうよ。
C/C++のポインタの機能--参照渡しのような処理 - builder by ZDNet Japan
で、Electric Fenceの紹介につなげる記事にしようと思ったのですが
electric-fence-win32 - Google Code
Electric Fenceのwin32版なんてものを見つけてしまった。
てっきりUNIX版と同様、リンクすれば動くと思って色々試したけど、どうやらそうじゃないみたい。
//#include <efence.h>
#include <stdio.h>
int main( void ) {
    char *a = (char*)malloc(12);
    a[ 0] = 'H';
    a[ 1] = 'e';
    a[ 2] = 'l';
    a[ 3] = 'l';
    a[ 4] = 'o';
    a[ 5] = ',';
    a[ 6] = ' ';
    a[ 7] = 'W';
    a[ 8] = 'o';
    a[ 9] = 'r';
    a[10] = 'l';
    a[11] = 'd';
    a[12] = '\0';
    return 0;
}
 オーバーランを検知してくれなかった。README.win32によると

Since you need to modify your own project anyway, simply add efence.c, page-win32.c, and print.c to your project.

と書いてありました。てっきりスタートアップルーチンを入れ替えてくれてくれる物かと思って少しだけ期待してしまいました。
mingw32ならば Index: Makefile
===================================================================
--- Makefile    (revision 7)
+++ Makefile    (working copy)
@@ -9,7 +9,7 @@
 MAN_INSTALL_DIR= /usr/man/man3
 
 PACKAGE_SOURCE= README libefence.3 Makefile efence.h \
-   efence.c page.c print.c eftest.c tstheap.c CHANGES COPYING
+   efence.c page-win32.c print.c eftest.c tstheap.c CHANGES COPYING
 
 # Un-comment the following if you are running HP/UX.
 # CFLAGS= -Aa -g -D_HPUX_SOURCE -DPAGE_PROTECTION_VIOLATED_SIGNAL=SIGBUS
@@ -26,7 +26,7 @@
 # as well if using Sun's compiler, -static if using GCC.
 # CFLAGS= -g -Bstatic -DPAGE_PROTECTION_VIOLATED_SIGNAL=SIGBUS
 
-OBJECTS= efence.o page.o print.o
+OBJECTS= efence.o page-win32.o print.o
 
 all:   libefence.a tstheap eftest
    @ echo
@@ -63,7 +63,7 @@
 
 tstheap: libefence.a tstheap.o
    - rm -f tstheap
-   $(CC) $(CFLAGS) tstheap.o libefence.a -o tstheap -lpthread
+   $(CC) $(CFLAGS) tstheap.o libefence.a -o tstheap -lpthreadGC2
 
 eftest: libefence.a eftest.o
    - rm -f eftest
 こんな風に修正して mingw32-make CC=gcc libefence.a でlibefence.aが出来上がり、上のソースの冒頭の「//」を外して #include <efence.h>
#include <stdio.h>
int main( void ) {
    char *a = (char*)malloc(12);
    a[ 0] = 'H';
    a[ 1] = 'e';
    a[ 2] = 'l';
    a[ 3] = 'l';
    a[ 4] = 'o';
    a[ 5] = ',';
    a[ 6] = ' ';
    a[ 7] = 'W';
    a[ 8] = 'o';
    a[ 9] = 'r';
    a[10] = 'l';
    a[11] = 'd';
    a[12] = '\0';
    return 0;
}
 あぶないコードに修正した後 gcc -g -o dame.exe dame.c -lefence とすれば、efenceビルドされたdame.exeが出来上がり実行すると、正しくクラッシュしてくれる。gdbで確認すれば
C:¥temp¥electric-fence-win32>gdb dame.exe
GNU gdb 6.3
Copyright 2004 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB.  Type "show warranty" for details.
This GDB was configured as "i686-pc-mingw32"...
(gdb) run
Starting program: C:¥temp¥electric-fence-win32/dame.exe
...
Program received signal SIGSEGV, Segmentation fault.
0x00401396 in main () at dame.c:17
17              a[12] = '\0';
(gdb)
 とクラッシュ場所も分かると。でもUNIX版みたくソースは修正したくないなぁ。
あとmallocでなく char a[12];
 とした場合にクラッシュしてくれないのならば、威力半減ってところか。
Posted at by