/[suikacvs]/messaging/manakai/doc/example/verify.pl
Suika

Contents of /messaging/manakai/doc/example/verify.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations) (download)
Sat Jul 20 08:42:56 2002 UTC (22 years, 4 months ago) by wakaba
Branch: MAIN
CVS Tags: before-dis2-200411, manakai-release-0-3-2, manakai-release-0-3-1, manakai-release-0-4-0, manakai-200612, HEAD
Branch point for: experimental-xml-parser-200401
File MIME type: text/plain
2002-07-20  Wakaba <w@suika.fam.cx>

	* verify.pl: New script.
	* sign.pl: Likewise.
	* ChangeLog: New file.

1 wakaba 1.1 #!/usr/bin/perl
2    
3     =head1 NAME
4    
5     verify.pl --- Sample script of Message::* Perl Modules
6     --- Verifying signed message with GnuPG
7    
8     =cut
9    
10     use strict;
11     use vars qw($VERSION);
12     $VERSION=do{my @r=(q$Revision: 1.10 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13     use Message::Entity;
14     use Getopt::Long;
15     my $gpg_path = 'gpg';
16     my $tmp_path = './';
17     GetOptions (
18     '--gpg-path=s' => \$gpg_path,
19     '--temp-dir=s' => \$tmp_path,
20     ) or die;
21    
22     my $msg;
23     {
24     binmode STDIN;
25     local $/ = undef;
26     $msg = Message::Entity->parse (<STDIN>, -linebreak_strict => 0);
27     }
28     die "This message is not signed" unless $msg->media_type eq 'multipart/signed';
29     my $protocol = lc $msg->header->field ('content-type')->item ('protocol');
30     die "Protocol $protocol is not supported" unless $protocol eq 'application/pgp-signature';
31     my $body = $msg->body->data_part (-parse => 0);
32     my $signature = $msg->body->control_part;
33    
34     die "Media type of signature (@{[scalar $signature->media_type]}) does not match with $protocol" unless $signature->media_type eq 'application/pgp-signature';
35    
36     open MSG, ">$tmp_path.signedmsg.tmp";
37     binmode MSG;
38     print MSG $body;
39     close MSG;
40     open SIG, ">$tmp_path.signature.tmp";
41     binmode SIG;
42     print SIG $signature->body;
43     close SIG;
44    
45     print `$gpg_path --verify --batch $tmp_path.signature.tmp $tmp_path.signedmsg.tmp`;
46     `rm $tmp_path.signature.tmp $tmp_path.signedmsg.tmp`;
47    
48     =head1 LICENSE
49    
50     Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
51    
52     This program is free software; you can redistribute it and/or modify
53     it under the terms of the GNU General Public License as published by
54     the Free Software Foundation; either version 2 of the License, or
55     (at your option) any later version.
56    
57     This program is distributed in the hope that it will be useful,
58     but WITHOUT ANY WARRANTY; without even the implied warranty of
59     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
60     GNU General Public License for more details.
61    
62     You should have received a copy of the GNU General Public License
63     along with this program; see the file COPYING. If not, write to
64     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
65     Boston, MA 02111-1307, USA.
66    
67     =head1 CHANGE
68    
69     See F<ChangeLog>.
70     $Date: 2002/07/20 03:11:47 $
71    
72     =cut
73    
74     ### verify.pl ends here

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24