package VOMS::Lite::ASN1Helper;
use 5.004;
use strict;
use warnings;
use Math::BigInt lib => 'GMP';
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
%EXPORT_TAGS = ( );
@EXPORT_OK = qw( Hex DecToHex ASN1BitStr ASN1Wrap ASN1UnwrapHex ASNLenStr ASN1Index ASN1Unwrap ASN1OIDtoOID OIDtoASN1OID);
@EXPORT = ( );
$VERSION = '0.16';
##################################################
sub Hex { #Converts a binary string to a padded string of hex values
my $data=shift;
return undef if ( ! defined $data );
my $str=unpack('H*',$data);
return ((length($str) & 1)?"0":"").$str;
}
##################################################
sub DecToHex { #Converts an 'integer' to a padded string of hex values
my $data=shift;
return undef if ( ! defined $data );
return "NaN" if ( $data !~ /^-?[0-9]+$/ );
my $num=Math::BigInt->new("$data");
$num->binc() if ( $data =~ /^-/ );
my $str=$num->as_hex();
$str =~ s/^-?0x//; # strip 0x and negative sign
$str =~ s/^.(..)*$/0$&/; # even up str
$str =~ s/^[89a-f]/00$&/; # convert to 2's complement as if positive
$str =~ y/0-9a-f/fedcba9876543210/ if ( $data =~ /^-/ ); # if negative, negate
return $str;
}
##################################################
sub ASN1OIDtoOID {
my ($val,$OIDstr)=(0,"");
foreach (split(//,shift)) { # Tackle OID one byte at a time
$val=($val*128)+ord($_&"\x7f"); # effectively shift $val 7 bits left add last 7 bits of $_
if (($_&"\x80") ne "\x80") { # If bit 8 is 0 then write append the value to the oid string
$OIDstr .= ( ( length($OIDstr) ) ? ".$val" : (int($val/40).".".$val%40) );
$val=0;
}
}
return $OIDstr;
}
sub OIDtoASN1OID {
if ( $_[0] !~ /^[0-9]+(?:\.[0-9]+)*$/ ) { return undef; }
my @nums=split /\./,$_[0];
unshift(@nums,shift(@nums)*40+shift(@nums));
my $OIDASN1str="";
foreach (@nums) {
my $str="";
while ( $_ > 0 ) {
my $m = $_ % 128;
$_ -= $m;
$m += 128 if ($str ne "");
$str = pack('C',$m).$str;
$_/=128;
}
$OIDASN1str .= $str;
}
return $OIDASN1str;
}
##################################################
sub ASN1BitStr { #Converts a hex representation of a bit string to an ASN1 bitstring primitive
my ($data,$length)=@_;
return undef if ( ! defined $data );
if ( defined $length ) {
my $wholebytes = int($length/8);
my $mask = Hex(pack('C',(2**((8-$length)%8)-1)));
return $mask.substr($data,0,$wholebytes*2);
}
return "00".$data;
}
##################################################
sub ASN1Wrap { #wraps an ASN1 structure with its ASN1 headers
my $Header=shift;
my $Data=shift;
return undef if (! defined $Header || ! defined $Data);
return $Header.ASNLenStr($Data).$Data;
}
##################################################
sub ASN1UnwrapHex {
my $data=shift;
return undef if ( ! defined $data );
$data=~ s/(..)/pack("C",hex($&))/ge;
return Hex(scalar ASN1Unwrap($data));
}
sub ASN1Unwrap {
my $BER=shift;
return (wantarray ? (0,0,undef,undef,undef,"") : "") if (! defined $BER );
my $inheader=1;
my ($Class,$Constructed,$Tag)=(0,0,0);
my ($headlen,$reallen,$lenlen)=(0,0,0);
# my $i;
for ( my $i = 0 ; $i <= length($BER) ; $i++ ) {
my $C=substr $BER,$i,1;
my @B=split(//, unpack("B*", $C));
if ( $inheader==1 ) { # ID First Byte
$headlen=1;
$Class= (shift @B)*2 + shift @B;
$Constructed=shift @B;
$Tag=unpack("N", pack("B32",substr("0" x 32 . join("",@B), -32 )));
if ($Tag==31) { $inheader=2; $Tag=0; }
else { $inheader=3; }
} elsif ( $inheader==2 ) { # ID Subsequent Bytes
$headlen++;
$inheader+=shift @B;
$Tag <<= 7;
$Tag=unpack("N", pack("B32",substr("0" x 32 . join("",@B), -32 )));
} elsif ( $inheader==3 ) { # Length First Byte
$headlen++;
if ( shift @B ) { $inheader=4; $reallen=0; $lenlen = unpack("N", pack("B32",substr("0" x 32 . join("",@B), -32 )));}
else { $inheader=-1; $lenlen=0; $reallen = unpack("N", pack("B32",substr("0" x 32 . join("",@B), -32 )));}
} elsif ( $inheader==4 ) { # Length Subsequent Bytes
$headlen++; $lenlen--;
$reallen+=(unpack("N", pack("B32",substr("0" x 32 . join("",@B), -32 ))))*(256**$lenlen);
if ( $lenlen == 0 ) { $inheader=-1;}
} else { #What's left: Primative or Construction
return wantarray ? ($headlen,$reallen,$Class,$Constructed,$Tag,substr($BER,$i,$reallen)) : substr($BER,$i,$reallen);
}
}
return wantarray ? (0,0,undef,undef,undef,"") : "";
}
##################################################
sub ASNLenStr { #expects Hex String returns ASN1 length header
my $data=shift;
return undef if ( ! defined $data );
my $len=length($data)/2;
if ($len <= 127) {
return unpack("H2",pack("i",$len));
} else {
my $lenlen=sprintf "%0x",$len;
if ( length($lenlen) & 1 ) { $lenlen='0'.$lenlen; }
return sprintf("%0x%s",((length($lenlen)/2)+128),$lenlen);
}
}
##################################################
# Subroutine to find structure of DER ASN.1
##################################################
sub ASN1Index {
my $data=shift;
return () if ( ! defined $data );
my @ContentStart=(0);
my $datalength=length($data);
my @ContentStop=($datalength);
my $pointer=0;
my @total=ASN1Unwrap(substr($data,$pointer,($ContentStop[-1]-$ContentStart[-1])));
if ( $total[0]+$total[1] != $datalength ) { return (); }
my @data;
while ( defined $ContentStop[-1] && $pointer < $ContentStop[0] ) {
my ($headlen,$reallen,$Class,$Constructed,$Tag,$Data) = ASN1Unwrap(substr($data,$pointer,($ContentStop[-1]-$ContentStart[-1])));
if ( ! defined $Class ) { return (); }
push @ContentStart,($pointer+$headlen);
push @ContentStop,($pointer+$headlen+$reallen);
push @data, [$Class,$Constructed,$Tag,$pointer,$headlen,$reallen];
$pointer+=$headlen;
$pointer+=$reallen if ($Constructed==0);
while ( defined $ContentStop[-1] && $pointer == $ContentStop[-1] ) {
if ( ! defined pop @ContentStop) { return (); }
if ( ! defined pop @ContentStart) { return (); }
}
}
return @data;
}
1;
__END__
=head1 VOMS::Lite::ASN1Helper
VOMS::Lite::ASN1Helper - Perl extension for basic ASN.1 encoding and decoding.
There is no OO in this module, it's a very basic straightforward implementation of ASN.1.
=head1 SYNOPSIS
use VOMS::Lite::ASN1Helper qw( Hex DecToHex ASN1BitStr ASN1Wrap ASN1UnwrapHex ASNLenStr ASN1Index ASN1Unwrap ASN1OIDtoOID);
# To convert a binary string, $data, to padded hex i.e. ([0-9a-f]{2})*
my $hexstr=Hex($data);
# To convert an integer to a padded string of hex values
my $hexint=DecToHex($int);
# To convert ASN1 represeantation of an OID to a dot representation e.g. 1.2.840.113549.1.9.1
my $OIDstr=ASN1OIDtoOID($data);
# To convert a dot representation of an OID (e.g. 1.2.840.113549.1.9.1) to an ASN1 represeantation
my $ASN1str=OIDtoASN1OID($oid);
# To convert a hex representation of a N*8 bit bytestring into an ASN1 bitstring
my $hexbitstr=ASN1BitStr($hexstr);
my $hexbitstr=ASN1BitStr($hexstr,$lengthinbits);
# To wrap a hex string into an ASN.1 Primative
my $objectstr=30; #30 denotes a SEQUENCE
my $asn1prim=ASN1Wrap($hexstr);
# To unwrap a chunk of BER encoded ASN.1
my $contents=ASN1Unwrap($data);
my $contentshex=ASN1UnwrapHex($data);
# or
my ($headerLength,$dataLength,$class,$constructed,$tag,$contents)=ASN1Unwrap($data);
# To return the ASN.1 length header for a hex representation of some data
my $LenghtHeaderHex=ASNLenStr($hexstr);
# To index an ASN.1 string
foreach ASN1Index($data) {
my ($class,$constructed,$tag,$position,$headLength,$dataLength)=@$_;
...
}
=head1 DESCRIPTION
VOMS::Lite::ASN1Helper is designed to provide simple ASN.1 encoding decoding methods for VOMS::Lite.
=head2 EXPORT
None by default.
By EXPORT_OK the following functions:
Hex
DecToHex
ASN1BitStr
ASN1Wrap
ASN1UnwrapHex
ASNLenStr
ASN1Index
ASN1Unwrap
ASN1OIDtoOID
OIDtoASN1OID
=head1 SEE ALSO
The X.680 and X.690 specifications:
http://www.itu.int/ITU-T/studygroups/com17/languages/
This module was originally designed for the SHEBANGS project at The University of Manchester.
http://www.mc.manchester.ac.uk/projects/shebangs/
now http://www.rcs.manchester.ac.uk/research/shebangs/
Mailing list, shebangs@listserv.manchester.ac.uk
Mailing list, voms-lite@listserv.manchester.ac.uk
If you have a mailing list set up for your module, mention it here.
If you have a web site set up for your module, mention it here.
=head1 AUTHOR
Mike Jones <mike.jones@manchester.ac.uk>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2006 by Mike Jones
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut