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

Contents of /nl.nikhef.pdp.fetchcrl/tags/fetch-crl-3.0.8-1/base64.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1759 - (show 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 #!/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