/[pdpsoft]/nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.3-1/base64.pm
ViewVC logotype

Annotation of /nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.3-1/base64.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1759 - (hide annotations) (download) (as text)
Fri Jun 11 15:41:40 2010 UTC (11 years, 5 months ago) by davidg
Original Path: trunk/fetchcrl/base64.pm
File MIME type: application/x-perl
File size: 6022 byte(s)
Moved fetch-crl to a tagger part of the repo

1 davidg 1758 #!/usr/bin/perl
2     # $Id: base64.pl,v 2.4 2004/05/17 04:18:13 ehood Exp $
3     #
4     # Library based on Perl 4 code from:
5     # base64.pl -- A perl package to handle MIME-style BASE64 encoding
6     # A. P. Barrett <barrett@ee.und.ac.za>, October 1993
7     # Revision: 1.4 Date: 1994/08/11 16:08:51
8     #
9     # Subsequent changes made by Earl Hood, earl@earlhood.com.
10    
11     package base64;
12    
13     my $_have_MIME_Base64;
14     BEGIN {
15     eval { require MIME::Base64; };
16     $_have_MIME_Base64 = scalar($@) ? 0 : 1;
17     }
18    
19     # Synopsis:
20     # require 'base64.pl';
21     #
22     # $uuencode_string = &base64::b64touu($base64_string);
23     # $binary_string = &base64::b64decode($base64_string);
24     # $base64_string = &base64::uutob64($uuencode_string);
25     # $base64_string = &base64::b64encode($binary_string);
26     # $uuencode_string = &base64::uuencode($binary_string);
27     # $binary_string = &base64::uudecode($uuencode_string);
28     #
29     # uuencode and base64 input strings may contain multiple lines,
30     # but may not contain any headers or trailers. (For uuencode,
31     # remove the begin and end lines, and for base64, remove the MIME
32     # headers and boundaries.)
33     #
34     # uuencode and base64 output strings will be contain multiple
35     # lines if appropriate, but will not contain any headers or
36     # trailers. (For uuencode, add the "begin" line and the
37     # " \nend\n" afterwards, and for base64, add any MIME stuff
38     # afterwards.)
39    
40     ####################
41    
42     my $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
43     'abcdefghijklmnopqrstuvwxyz'.
44     '0123456789+/';
45     my $base64_pad = '=';
46    
47     my $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.
48     '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_';
49     my $uuencode_pad = '`';
50    
51     # Build some strings for use in tr/// commands.
52     # Some uuencodes use " " and some use "`", so we handle both.
53     # We also need to protect backslashes and other special characters.
54     my $tr_uuencode = " ".$uuencode_alphabet;
55     $tr_uuencode =~ s/(\W)/\\$1/g;
56     my $tr_base64 = "A".$base64_alphabet;
57     $tr_base64 =~ s/(\W)/\\$1/g;
58    
59     sub b64touu
60     {
61     local ($_) = shift;
62     my ($result);
63    
64     # zap bad characters and translate others to uuencode alphabet
65     eval qq{
66     tr|$tr_base64||cd;
67     tr|$tr_base64|$tr_uuencode|;
68     };
69    
70     # break into lines of 60 encoded chars, prepending "M" for uuencode
71     while (s/^(.{60})//) {
72     $result .= 'M' . $1 . "\n";
73     }
74    
75     # any leftover chars go onto a shorter line
76     # with padding to the next multiple of 4 chars
77     if ($_ ne '') {
78     $result .= substr($uuencode_alphabet, length($_)*3/4, 1)
79     . $_
80     . ($uuencode_pad x ((60 - length($_)) % 4)) . "\n";
81     }
82    
83     # return result
84     $result;
85     }
86    
87     sub b64decode
88     {
89     # call more efficient module if available (ehood, 2003-09-28)
90     if ($_have_MIME_Base64) {
91     return &MIME::Base64::decode_base64;
92     }
93    
94     # substr() usage added by ehood, 1996/04/16
95    
96     my($str) = shift;
97     my($result, $tmp, $offset, $len);
98    
99     # zap bad characters and translate others to uuencode alphabet
100     eval qq{
101     \$str =~ tr|$tr_base64||cd;
102     \$str =~ tr|$tr_base64|$tr_uuencode|;
103     };
104    
105     # break into lines of 60 encoded chars, prepending "M" for uuencode,
106     # and then using perl's builtin uudecoder to convert to binary.
107     $result = ''; # init return string
108     $offset = 0; # init offset to 0
109     $len = length($str); # store length
110     while ($offset+60 <= $len) { # loop until < 60 chars left
111     $tmp = substr($str, $offset, 60); # grap 60 char block
112     $offset += 60; # increment offset
113     $result .= unpack('u', 'M' . $tmp); # decode block
114     }
115     # also decode any leftover chars
116     if ($offset < $len) {
117     $tmp = substr($str, $offset, $len-$offset);
118     $result .= unpack('u',
119     substr($uuencode_alphabet, length($tmp)*3/4, 1) . $tmp);
120     }
121    
122     # return result
123     $result;
124     }
125    
126     sub uutob64
127     {
128     # This is the most difficult, because some perverse uuencoder
129     # might have made lines that do not describe multiples of 3 bytes.
130     # I don't see any better method than uudecoding to binary and then
131     # b64encoding the binary.
132    
133     &b64encode(&uudecode); # implicitly pass @_ to &uudecode
134     }
135    
136     sub b64encode
137     {
138     # call more efficient module if available (ehood, 2003-09-28)
139     if ($_have_MIME_Base64) {
140     return &MIME::Base64::encode_base64;
141     }
142    
143     local ($_) = shift;
144     my ($chunk);
145     my ($result);
146    
147     # break into chunks of 45 input chars, use perl's builtin
148     # uuencoder to convert each chunk to uuencode format,
149     # then kill the leading "M", translate to the base64 alphabet,
150     # and finally append a newline.
151     while (s/^([\s\S]{45})//) {
152     $chunk = substr(pack('u', $1), $[+1, 60);
153     eval qq{
154     \$chunk =~ tr|$tr_uuencode|$tr_base64|;
155     };
156     $result .= $chunk . "\n";
157     }
158    
159     # any leftover chars go onto a shorter line
160     # with uuencode padding converted to base64 padding
161     if ($_ ne '') {
162     $chunk = substr(pack('u', $_), $[+1,
163     int((length($_)+2)/3)*4 - (45-length($_))%3);
164     eval qq{
165     \$chunk =~ tr|$tr_uuencode|$tr_base64|;
166     };
167     $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";
168     }
169    
170     # return result
171     $result;
172     }
173    
174     sub uuencode
175     {
176     local ($_) = shift;
177     my ($result);
178    
179     # break into chunks of 45 input chars, and use perl's builtin
180     # uuencoder to convert each chunk to uuencode format.
181     # (newline is added by builtin uuencoder.)
182     while (s/^([\s\S]{45})//) {
183     $result .= pack('u', $1);
184     }
185    
186     # any leftover chars go onto a shorter line
187     # with padding to the next multiple of 4 chars
188     if ($_ ne '') {
189     $result .= pack('u', $_);
190     }
191    
192     # return result
193     $result;
194     }
195    
196     sub uudecode
197     {
198     local ($_) = shift;
199     my $result = '';
200    
201     # strip out begin/end lines (ehood, 1996/03/21)
202     s/^\s*begin[^\n]+\n//;
203     s/\nend\s*$//;
204    
205     # use perl's builtin uudecoder to convert each line
206     while (s/^([^\n]+\n?)//) {
207     last if substr($1, 0, 1) eq '`';
208     $result .= unpack('u', $1);
209     }
210    
211     # return result
212     $result;
213     }
214    
215     1;

grid.support@nikhef.nl
ViewVC Help
Powered by ViewVC 1.1.28