tags/0.4.3.1-pre2/SrSv/Unreal/Base64.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::Unreal::Base64;
  18
  19 =head1 NAME
  20
  21 SrSv::Unreal::Base64 - Implementation of the UnrealIRCd Base64 encoding
  22
  23 =cut
  24
  25 use strict;
  26 use SrSv::64bit;
  27 BEGIN {
  28         if(!HAS_64BIT_INT) {
  29                 eval {
  30                         require Math::BigInt;
  31                         import Math::BigInt try => 'GMP';
  32                 };
  33                 if($@) {
  34                         print STDERR "Running old version of perl/Math::BigInt.\n", $@, "Trying again.\n";
  35                         require Math::BigInt;
  36                         import Math::BigInt;
  37                 }
  38         }
  39 }
  40
  41 use Exporter 'import';
  42 BEGIN { our @EXPORT_OK = qw(b64toi itob64); }
  43
  44 # ':' and '#' and '&' and '+' and '@' must never be in this table. */
  45 # these tables must NEVER CHANGE! >) */
  46 our @int6_to_base64_map = (
  47         '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D',
  48             'E', 'F',
  49         'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T',
  50             'U', 'V',
  51         'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j',
  52             'k', 'l',
  53         'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z',
  54             '{', '}'
  55 );
  56
  57 our @base64_to_int6_map = (
  58         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  59         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  60         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  61         0, 1, 2, 3, 4, 5, 6, 7, 8, 9, -1, -1, -1, -1, -1, -1,
  62         -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
  63         25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1,
  64         -1, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
  65         51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, -1, 63, -1, -1,
  66         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  67         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  68         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  69         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  70         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  71         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  72         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
  73         -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1
  74 );
  75
  76 *b64toi = \&base64_to_int;
  77 sub base64_to_int($) {
  78         my ($base64) = @_;
  79         my $val = 0;
  80         #wKgIAw==
  81         if(length($base64) > 8) {
  82                 warn "greater-than-32bit base64($base64) in base64_to_int";
  83                 $val = (HAS_64BIT_INT ? 0 : Math::BigInt->bzero());
  84         } else {
  85                 $val = 0;
  86         }
  87
  88         foreach my $ch (split(//, $base64)) {
  89                 $val <<= 6;
  90                 $val += $base64_to_int6_map[ord($ch)];
  91         }
  92         return $val;
  93 }
  94
  95 *itob64 = \&int_to_base64;
  96 sub int_to_base64($) {
  97         my ($val) = @_;
  98
  99         my $base64 = '';
 100         do {
 101                 $base64 .= $int6_to_base64_map[$val & 63];
 102         } while ($val >>= 6);
 103         return scalar reverse($base64);
 104 }
 105
 106 1;
 107
 108 __END__
 109
 110 =head1 SYNOPSIS
 111
 112  use SrSv::Unreal::Base64;
 113  $integer = b64toi($base64);
 114  $base64 = itob64($integer);
 115
 116 =head1 NOTES
 117
 118 As far as I know, all usage of these functions will accept or return
 119 a 32-bit integer. The only exception is for IPv6, but NICKIP uses the
 120 standard table anyway.