[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # Copyright (c) 2000-2005 Graham Barr <gbarr@pobox.com>. All rights reserved. 2 # This program is free software; you can redistribute it and/or 3 # modify it under the same terms as Perl itself. 4 5 package Convert::ASN1; 6 7 BEGIN { 8 unless (CHECK_UTF8) { 9 local $SIG{__DIE__}; 10 eval { require bytes } and 'bytes'->import 11 } 12 } 13 14 # These are the subs which do the encoding, they are called with 15 # 0 1 2 3 4 5 16 # $opt, $op, $stash, $var, $buf, $loop 17 # The order in the array must match the op definitions above 18 19 my @encode = ( 20 sub { die "internal error\n" }, 21 \&_enc_boolean, 22 \&_enc_integer, 23 \&_enc_bitstring, 24 \&_enc_string, 25 \&_enc_null, 26 \&_enc_object_id, 27 \&_enc_real, 28 \&_enc_sequence, 29 \&_enc_sequence, # SET is the same encoding as sequence 30 \&_enc_time, 31 \&_enc_time, 32 \&_enc_utf8, 33 \&_enc_any, 34 \&_enc_choice, 35 \&_enc_object_id, 36 \&_enc_bcd, 37 ); 38 39 40 sub _encode { 41 my ($optn, $ops, $stash, $path) = @_; 42 my $var; 43 44 foreach my $op (@{$ops}) { 45 if (defined(my $opt = $op->[cOPT])) { 46 next unless defined $stash->{$opt}; 47 } 48 if (defined($var = $op->[cVAR])) { 49 push @$path, $var; 50 require Carp, Carp::croak(join(".", @$path)," is undefined") unless defined $stash->{$var}; 51 } 52 $_[4] .= $op->[cTAG]; 53 54 &{$encode[$op->[cTYPE]]}( 55 $optn, 56 $op, 57 (UNIVERSAL::isa($stash, 'HASH') 58 ? ($stash, defined($var) ? $stash->{$var} : undef) 59 : ({}, $stash)), 60 $_[4], 61 $op->[cLOOP], 62 $path, 63 ); 64 65 pop @$path if defined $var; 66 } 67 68 $_[4]; 69 } 70 71 72 sub _enc_boolean { 73 # 0 1 2 3 4 5 6 74 # $optn, $op, $stash, $var, $buf, $loop, $path 75 76 $_[4] .= pack("CC",1, $_[3] ? 0xff : 0); 77 } 78 79 80 sub _enc_integer { 81 # 0 1 2 3 4 5 6 82 # $optn, $op, $stash, $var, $buf, $loop, $path 83 if (abs($_[3]) >= 2**31) { 84 my $os = i2osp($_[3], ref($_[3]) || $_[0]->{encode_bigint} || 'Math::BigInt'); 85 my $len = length $os; 86 my $msb = (vec($os, 0, 8) & 0x80) ? 0 : 255; 87 $len++, $os = chr($msb) . $os if $msb xor $_[3] > 0; 88 $_[4] .= asn_encode_length($len); 89 $_[4] .= $os; 90 } 91 else { 92 my $val = int($_[3]); 93 my $neg = ($val < 0); 94 my $len = num_length($neg ? ~$val : $val); 95 my $msb = $val & (0x80 << (($len - 1) * 8)); 96 97 $len++ if $neg ? !$msb : $msb; 98 99 $_[4] .= asn_encode_length($len); 100 $_[4] .= substr(pack("N",$val), -$len); 101 } 102 } 103 104 105 sub _enc_bitstring { 106 # 0 1 2 3 4 5 6 107 # $optn, $op, $stash, $var, $buf, $loop, $path 108 my $vref = ref($_[3]) ? \($_[3]->[0]) : \$_[3]; 109 110 if (CHECK_UTF8 and Encode::is_utf8($$vref)) { 111 utf8::encode(my $tmp = $$vref); 112 $vref = \$tmp; 113 } 114 115 if (ref($_[3])) { 116 my $less = (8 - ($_[3]->[1] & 7)) & 7; 117 my $len = ($_[3]->[1] + 7) >> 3; 118 $_[4] .= asn_encode_length(1+$len); 119 $_[4] .= chr($less); 120 $_[4] .= substr($$vref, 0, $len); 121 if ($less && $len) { 122 substr($_[4],-1) &= chr((0xff << $less) & 0xff); 123 } 124 } 125 else { 126 $_[4] .= asn_encode_length(1+length $$vref); 127 $_[4] .= chr(0); 128 $_[4] .= $$vref; 129 } 130 } 131 132 133 sub _enc_string { 134 # 0 1 2 3 4 5 6 135 # $optn, $op, $stash, $var, $buf, $loop, $path 136 137 if (CHECK_UTF8 and Encode::is_utf8($_[3])) { 138 utf8::encode(my $tmp = $_[3]); 139 $_[4] .= asn_encode_length(length $tmp); 140 $_[4] .= $tmp; 141 } 142 else { 143 $_[4] .= asn_encode_length(length $_[3]); 144 $_[4] .= $_[3]; 145 } 146 } 147 148 149 sub _enc_null { 150 # 0 1 2 3 4 5 6 151 # $optn, $op, $stash, $var, $buf, $loop, $path 152 153 $_[4] .= chr(0); 154 } 155 156 157 sub _enc_object_id { 158 # 0 1 2 3 4 5 6 159 # $optn, $op, $stash, $var, $buf, $loop, $path 160 161 my @data = ($_[3] =~ /(\d+)/g); 162 163 if ($_[1]->[cTYPE] == opOBJID) { 164 if(@data < 2) { 165 @data = (0); 166 } 167 else { 168 my $first = $data[1] + ($data[0] * 40); 169 splice(@data,0,2,$first); 170 } 171 } 172 173 my $l = length $_[4]; 174 $_[4] .= pack("cw*", 0, @data); 175 substr($_[4],$l,1) = asn_encode_length(length($_[4]) - $l - 1); 176 } 177 178 179 sub _enc_real { 180 # 0 1 2 3 4 5 6 181 # $optn, $op, $stash, $var, $buf, $loop, $path 182 183 # Zero 184 unless ($_[3]) { 185 $_[4] .= chr(0); 186 return; 187 } 188 189 require POSIX; 190 191 # +oo (well we use HUGE_VAL as Infinity is not avaliable to perl) 192 if ($_[3] >= POSIX::HUGE_VAL()) { 193 $_[4] .= pack("C*",0x01,0x40); 194 return; 195 } 196 197 # -oo (well we use HUGE_VAL as Infinity is not avaliable to perl) 198 if ($_[3] <= - POSIX::HUGE_VAL()) { 199 $_[4] .= pack("C*",0x01,0x41); 200 return; 201 } 202 203 if (exists $_[0]->{'encode_real'} && $_[0]->{'encode_real'} ne 'binary') { 204 my $tmp = sprintf("%g",$_[3]); 205 $_[4] .= asn_encode_length(1+length $tmp); 206 $_[4] .= chr(1); # NR1? 207 $_[4] .= $tmp; 208 return; 209 } 210 211 # We have a real number. 212 my $first = 0x80; 213 my($mantissa, $exponent) = POSIX::frexp($_[3]); 214 215 if ($mantissa < 0.0) { 216 $mantissa = -$mantissa; 217 $first |= 0x40; 218 } 219 my($eMant,$eExp); 220 221 while($mantissa > 0.0) { 222 ($mantissa, my $int) = POSIX::modf($mantissa * (1<<8)); 223 $eMant .= chr($int); 224 } 225 $exponent -= 8 * length $eMant; 226 227 _enc_integer(undef, undef, undef, $exponent, $eExp); 228 229 # $eExp will br prefixed by a length byte 230 231 if (5 > length $eExp) { 232 $eExp =~ s/\A.//s; 233 $first |= length($eExp)-1; 234 } 235 else { 236 $first |= 0x3; 237 } 238 239 $_[4] .= asn_encode_length(1 + length($eMant) + length($eExp)); 240 $_[4] .= chr($first); 241 $_[4] .= $eExp; 242 $_[4] .= $eMant; 243 } 244 245 246 sub _enc_sequence { 247 # 0 1 2 3 4 5 6 248 # $optn, $op, $stash, $var, $buf, $loop, $path 249 250 if (my $ops = $_[1]->[cCHILD]) { 251 my $l = length $_[4]; 252 $_[4] .= "\0\0"; # guess 253 if (defined $_[5]) { 254 my $op = $ops->[0]; # there should only be one 255 my $enc = $encode[$op->[cTYPE]]; 256 my $tag = $op->[cTAG]; 257 my $loop = $op->[cLOOP]; 258 259 push @{$_[6]}, -1; 260 261 foreach my $var (@{$_[3]}) { 262 $_[6]->[-1]++; 263 $_[4] .= $tag; 264 265 &{$enc}( 266 $_[0], # $optn 267 $op, # $op 268 $_[2], # $stash 269 $var, # $var 270 $_[4], # $buf 271 $loop, # $loop 272 $_[6], # $path 273 ); 274 } 275 pop @{$_[6]}; 276 } 277 else { 278 _encode($_[0],$_[1]->[cCHILD], defined($_[3]) ? $_[3] : $_[2], $_[6], $_[4]); 279 } 280 substr($_[4],$l,2) = asn_encode_length(length($_[4]) - $l - 2); 281 } 282 else { 283 $_[4] .= asn_encode_length(length $_[3]); 284 $_[4] .= $_[3]; 285 } 286 } 287 288 289 my %_enc_time_opt = ( utctime => 1, withzone => 0, raw => 2); 290 291 sub _enc_time { 292 # 0 1 2 3 4 5 6 293 # $optn, $op, $stash, $var, $buf, $loop, $path 294 295 my $mode = $_enc_time_opt{$_[0]->{'encode_time'} || ''} || 0; 296 297 if ($mode == 2) { 298 $_[4] .= asn_encode_length(length $_[3]); 299 $_[4] .= $_[3]; 300 return; 301 } 302 303 my @time; 304 my $offset; 305 my $isgen = $_[1]->[cTYPE] == opGTIME; 306 307 if (ref($_[3])) { 308 $offset = int($_[3]->[1] / 60); 309 $time = $_[3]->[0] + $_[3]->[1]; 310 } 311 elsif ($mode == 0) { 312 if (exists $_[0]->{'encode_timezone'}) { 313 $offset = int($_[0]->{'encode_timezone'} / 60); 314 $time = $_[3] + $_[0]->{'encode_timezone'}; 315 } 316 else { 317 @time = localtime($_[3]); 318 my @g = gmtime($_[3]); 319 320 $offset = ($time[1] - $g[1]) + ($time[2] - $g[2]) * 60; 321 $time = $_[3] + $offset*60; 322 } 323 } 324 else { 325 $time = $_[3]; 326 } 327 @time = gmtime($time); 328 $time[4] += 1; 329 $time[5] = $isgen ? ($time[5] + 1900) : ($time[5] % 100); 330 331 my $tmp = sprintf("%02d"x6, @time[5,4,3,2,1,0]); 332 if ($isgen) { 333 my $sp = sprintf("%.03f",$time); 334 $tmp .= substr($sp,-4) unless $sp =~ /\.000$/; 335 } 336 $tmp .= $offset ? sprintf("%+03d%02d",$offset / 60, abs($offset % 60)) : 'Z'; 337 $_[4] .= asn_encode_length(length $tmp); 338 $_[4] .= $tmp; 339 } 340 341 342 sub _enc_utf8 { 343 # 0 1 2 3 4 5 6 344 # $optn, $op, $stash, $var, $buf, $loop, $path 345 346 if (CHECK_UTF8) { 347 my $tmp = $_[3]; 348 utf8::upgrade($tmp) unless Encode::is_utf8($tmp); 349 utf8::encode($tmp); 350 $_[4] .= asn_encode_length(length $tmp); 351 $_[4] .= $tmp; 352 } 353 else { 354 $_[4] .= asn_encode_length(length $_[3]); 355 $_[4] .= $_[3]; 356 } 357 } 358 359 360 sub _enc_any { 361 # 0 1 2 3 4 5 6 362 # $optn, $op, $stash, $var, $buf, $loop, $path 363 364 my $handler; 365 if ($_[1]->[cDEFINE] && $_[2]->{$_[1]->[cDEFINE]}) { 366 $handler=$_[0]->{oidtable}{$_[2]->{$_[1]->[cDEFINE]}}; 367 $handler=$_[0]->{handlers}{$_[1]->[cVAR]}{$_[2]->{$_[1]->[cDEFINE]}} unless $handler; 368 } 369 if ($handler) { 370 $_[4] .= $handler->encode($_[3]); 371 } else { 372 $_[4] .= $_[3]; 373 } 374 } 375 376 377 sub _enc_choice { 378 # 0 1 2 3 4 5 6 379 # $optn, $op, $stash, $var, $buf, $loop, $path 380 381 my $stash = defined($_[3]) ? $_[3] : $_[2]; 382 for my $op (@{$_[1]->[cCHILD]}) { 383 my $var = defined $op->[cVAR] ? $op->[cVAR] : $op->[cCHILD]->[0]->[cVAR]; 384 385 if (exists $stash->{$var}) { 386 push @{$_[6]}, $var; 387 _encode($_[0],[$op], $stash, $_[6], $_[4]); 388 pop @{$_[6]}; 389 return; 390 } 391 } 392 require Carp; 393 Carp::croak("No value found for CHOICE " . join(".", @{$_[6]})); 394 } 395 396 397 sub _enc_bcd { 398 # 0 1 2 3 4 5 6 399 # $optn, $op, $stash, $var, $buf, $loop, $path 400 my $str = ("$_[3]" =~ /^(\d+)/) ? $1 : ""; 401 $str .= "F" if length($str) & 1; 402 $_[4] .= asn_encode_length(length($str) / 2); 403 $_[4] .= pack("H*", $str); 404 } 405 1; 406
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |