summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm247
1 files changed, 247 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm b/Master/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm
new file mode 100755
index 00000000000..b941ec11783
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/Convert/ASCII/Armour.pm
@@ -0,0 +1,247 @@
+#!/usr/bin/perl -sw
+##
+## Convert::ASCII::Armour
+##
+## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved.
+## This code is free software; you can redistribute it and/or modify
+## it under the same terms as Perl itself.
+##
+## $Id: Armour.pm,v 1.4 2001/03/19 23:15:09 vipul Exp $
+
+package Convert::ASCII::Armour;
+use strict;
+use Digest::MD5 qw(md5);
+use MIME::Base64;
+use Compress::Zlib qw(compress uncompress);
+use vars qw($VERSION);
+
+($VERSION) = '$Revision: 1.4 $' =~ /\s(\d+\.\d+)\s/;
+
+
+sub new {
+ return bless {}, shift;
+}
+
+
+sub error {
+ my ($self, $errstr) = @_;
+ $$self{errstr} = "$errstr\n";
+ return;
+}
+
+
+sub errstr {
+ my $self = shift;
+ return $$self{errstr};
+}
+
+
+sub armour {
+
+ my ($self, %params) = @_;
+
+ my $compress = $params{Compress} ? "COMPRESSED " : "";
+ return undef unless $params{Content};
+ $params{Object} = "UNKNOWN $compress DATA" unless $params{Object};
+
+ my $head = "-"x5 . "BEGIN $compress$params{Object}" . "-"x5;
+ my $tail = "-"x5 . "END $compress$params{Object}" . "-"x5;
+
+ my $content = $self->encode_content (%{$params{Content}});
+ $content = compress($content) if $compress;
+ my $checksum = encode_base64 (md5 ($content));
+ my $econtent = encode_base64 ($content);
+
+ my $eheaders = "";
+ for my $key (keys %{$params{Headers}}) {
+ $eheaders .= "$key: $params{Headers}->{$key}\n";
+ }
+
+ my $message = "$head\n$eheaders\n$econtent=$checksum$tail\n";
+ return $message;
+
+}
+
+
+sub unarmour {
+ my ($self, $message) = @_;
+
+ my ($head, $object, $headers, $content, $tail) = $message =~
+ m:(-----BEGIN ([^\n\-]+)-----)\n(.*?\n\n)?(.+)(-----END .*?-----)$:s
+ or return $self->error ("Breached Armour.");
+
+ my ($compress, $obj) = $object =~ /^(COMPRESSED )(.*)$/;
+ $object = $obj if $obj;
+ $content =~ s:=([^\n]+)$::s or return $self->error ("Breached Armour.");
+ my $checksum = $1; $content = decode_base64 ($content);
+ my $ncheck = encode_base64 (md5 ($content)); $ncheck =~ s/\n//;
+ return $self->error ("Checksum Failed.") unless $ncheck eq $checksum;
+ $content = uncompress ($content) if $compress;
+ my $dcontent = $self->decode_content ($content) || return;
+
+ my $dheaders;
+ if ($headers) {
+ my @pairs = split /\n/, $headers;
+ for (@pairs) {
+ my ($key, $value) = split /: /, $_, 2;
+ $$dheaders{$key} = $value if $key;
+ }
+ }
+
+ my %return = ( Content => $dcontent,
+ Object => $object,
+ Headers => $dheaders );
+
+ return \%return;
+
+}
+
+
+sub encode_content {
+ my ($self, %data) = @_;
+ my $encoded = "";
+
+ for my $key (keys %data) {
+ $encoded .= length ($key) . chr(0) . length ($data{$key}) .
+ chr(0) . "$key$data{$key}";
+ }
+
+ return $encoded;
+}
+
+
+sub decode_content {
+ my ($self, $content) = @_;
+ my %data;
+
+ while ($content) {
+ $content =~ s/^(\d+)\x00(\d+)\x00// ||
+ return $self->error ("Inconsistent content.");
+ my $keylen = $1; my $valuelen = $2;
+ my $key = substr $content, 0, $keylen;
+ my $value = substr $content, $keylen, $valuelen;
+ substr ($content, 0, $keylen + $valuelen) = "";
+ $data{$key} = $value;
+ }
+
+ return \%data;
+}
+
+
+sub armor { armour (@_) }
+sub unarmor { unarmour (@_) }
+
+
+1;
+
+
+=head1 NAME
+
+Convert::ASCII::Armour - Convert binary octets into ASCII armoured messages.
+
+=head1 SYNOPSIS
+
+ my $converter = new Convert::ASCII::Armour;
+
+ my $message = $converter->armour(
+ Object => "FOO RECORD",
+ Headers => {
+ Table => "FooBar",
+ Version => "1.23",
+ },
+ Content => {
+ Key => "0x8738FA7382",
+ Name => "Zoya Hall",
+ Pic => "....", # gif
+ },
+ Compress => 1,
+ );
+
+ print $message;
+
+
+ -----BEGIN COMPRESSED FOO RECORD-----
+ Version: 1.23
+ Table: FooBar
+
+ eJwzZzA0Z/BNLS5OTE8NycgsVgCiRIVciIAJg6EJg0tiSaqhsYJvYlFy...
+ XnpOZl5qYlJySmpaekZmVnZObl5+QWFRcUlpWXlFZRWXAk7g6OTs4urm...
+ Fh4VGaWAR5ehkbGJqZm5hSUeNXWKDsoGcWpaGpq68bba0dWxtTVmDOYM...
+ NzuZ
+ =MxpZvjkrv5XyhkVCuXmsBQ==
+ -----END COMPRESSED FOO RECORD-----
+
+
+ my $decoded = $converter->unarmour( $message )
+ || die $converter->errstr();
+
+
+=head1 DESCRIPTION
+
+This module converts hashes of binary octets into ASCII messages suitable
+for transfer over 6-bit clean transport channels. The encoded ASCII
+resembles PGP's armoured messages, but are in no way compatible with PGP.
+
+=head1 METHODS
+
+=head2 B<new()>
+
+Constructor.
+
+=head2 B<armour()>
+
+Converts a hash of binary octets into an ASCII encoded message. The
+encoded message has 4 parts: head and tail strings that act as identifiers
+and delimiters, a cluster of headers at top of the message, Base64 encoded
+message body and a Base64 encoded MD5 digest of the message body. armour()
+takes a hash as argument with following keys:
+
+=over 4
+
+=item B<Object>
+
+An identification string embedded in head and tail strings.
+
+=item B<Content>
+
+Content is a hashref that contains the binary octets to be encoded. This
+hash is serialized, compressed (if specified) and encoded into ASCII with
+MIME::Base64. The result is the body of the encoded message.
+
+=item B<Headers>
+
+Headers is a hashref that contains ASCII headers that are placed at top of
+the encoded message. Headers are encoded as RFC822 headers.
+
+=item B<Compress>
+
+A boolean parameter that forces armour() to compress the message body.
+
+=back
+
+=head2 B<unarmour()>
+
+Decodes an armoured ASCII message into the hash provided as argument
+to armour(). The hash contains Content, Object, and Headers.
+unarmour() performs several consistency checks and returns a non-true
+value on failure.
+
+=head2 B<errstr()>
+
+Returns the error message set by unarmour() on failure.
+
+=head1 AUTHOR
+
+Vipul Ved Prakash, E<lt>mail@vipul.netE<gt>
+
+=head1 LICENSE
+
+Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. This code is
+free software; you can redistribute it and/or modify it under the same
+terms as Perl itself.
+
+=head1 SEE ALSO
+
+MIME::Base64(3), Compress::Zlib(3), Digest::MD5(3)
+
+=cut