|
265
|
1 /* base64 interface for XEmacs.
|
|
388
|
2 Copyright (C) 1998, 1999 Free Software Foundation, Inc.
|
|
265
|
3
|
|
|
4 This file is part of XEmacs.
|
|
|
5
|
|
|
6 XEmacs is free software; you can redistribute it and/or modify it
|
|
|
7 under the terms of the GNU General Public License as published by the
|
|
|
8 Free Software Foundation; either version 2, or (at your option) any
|
|
|
9 later version.
|
|
|
10
|
|
|
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
|
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
|
14 for more details.
|
|
|
15
|
|
|
16 You should have received a copy of the GNU General Public License
|
|
|
17 along with XEmacs; see the file COPYING. If not, write to
|
|
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
19 Boston, MA 02111-1307, USA. */
|
|
|
20
|
|
|
21 /* Synched up with: Not in FSF. */
|
|
|
22
|
|
|
23 /* Author: William Perry <wmperry@aventail.com> */
|
|
|
24
|
|
388
|
25 #include <emodules.h>
|
|
265
|
26
|
|
|
27 unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
|
|
|
28
|
|
|
29 DEFUN ("base64-encode", Fbase64_encode, 1, 5, 0, /*
|
|
|
30 Return the base64 encoding of an object.
|
|
|
31 OBJECT is either a string or a buffer.
|
|
|
32 Optional arguments START and END denote buffer positions for computing the
|
|
|
33 hash of a portion of OBJECT. The optional CODING argument specifies the coding
|
|
|
34 system the text is to be represented in while computing the digest. This only
|
|
|
35 has meaning with MULE, and defaults to the current format of the data.
|
|
|
36 If ERROR-ME-NOT is nil, report an error if the coding system can't be
|
|
|
37 determined. Else assume binary coding if all else fails.
|
|
|
38 */
|
|
|
39 (object, start, end, coding, error_me_not))
|
|
|
40 {
|
|
|
41 int cols,bits,char_count;
|
|
|
42 Lisp_Object instream, outstream,deststream;
|
|
|
43 Lstream *istr, *ostr, *dstr;
|
|
|
44 static Extbyte_dynarr *conversion_out_dynarr;
|
|
|
45 static Extbyte_dynarr *out_dynarr;
|
|
|
46 char tempbuf[1024]; /* some random amount */
|
|
|
47 struct gcpro gcpro1, gcpro2;
|
|
|
48 #ifdef FILE_CODING
|
|
|
49 Lisp_Object conv_out_stream, coding_system;
|
|
|
50 Lstream *costr;
|
|
|
51 struct gcpro gcpro3;
|
|
|
52 #endif
|
|
|
53
|
|
|
54 if (!conversion_out_dynarr)
|
|
|
55 conversion_out_dynarr = Dynarr_new (Extbyte);
|
|
|
56 else
|
|
|
57 Dynarr_reset (conversion_out_dynarr);
|
|
|
58
|
|
|
59 if (!out_dynarr)
|
|
|
60 out_dynarr = Dynarr_new(Extbyte);
|
|
|
61 else
|
|
|
62 Dynarr_reset (out_dynarr);
|
|
|
63
|
|
|
64 char_count = bits = cols = 0;
|
|
|
65
|
|
|
66 /* set up the in stream */
|
|
|
67 if (BUFFERP (object))
|
|
|
68 {
|
|
|
69 struct buffer *b = decode_buffer (object, 1);
|
|
|
70 Bufpos begv, endv;
|
|
|
71 /* Figure out where we need to get info from */
|
|
|
72 get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL);
|
|
|
73
|
|
|
74 instream = make_lisp_buffer_input_stream (b, begv, endv, 0);
|
|
|
75 }
|
|
|
76 else
|
|
|
77 {
|
|
|
78 Bytecount bstart, bend;
|
|
|
79 CHECK_STRING (object);
|
|
|
80 get_string_range_byte (object, start, end, &bstart, &bend,
|
|
|
81 GB_HISTORICAL_STRING_BEHAVIOR);
|
|
|
82 instream = make_lisp_string_input_stream (object, bstart, bend);
|
|
|
83 }
|
|
|
84 istr = XLSTREAM (instream);
|
|
|
85
|
|
|
86 #ifdef FILE_CODING
|
|
|
87 /* Find out what format the buffer will be saved in, so we can make
|
|
|
88 the digest based on what it will look like on disk */
|
|
|
89 if (NILP(coding))
|
|
|
90 {
|
|
|
91 if (BUFFERP(object))
|
|
|
92 {
|
|
|
93 /* Use the file coding for this buffer by default */
|
|
|
94 coding_system = XBUFFER(object)->buffer_file_coding_system;
|
|
|
95 }
|
|
|
96 else
|
|
|
97 {
|
|
|
98 /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */
|
|
|
99 enum eol_type eol = EOL_AUTODETECT;
|
|
|
100 coding_system = Fget_coding_system(Qundecided);
|
|
|
101 determine_real_coding_system(istr, &coding_system, &eol);
|
|
|
102 }
|
|
|
103 if (NILP(coding_system))
|
|
|
104 coding_system = Fget_coding_system(Qbinary);
|
|
|
105 else
|
|
|
106 {
|
|
|
107 coding_system = Ffind_coding_system (coding_system);
|
|
|
108 if (NILP(coding_system))
|
|
|
109 coding_system = Fget_coding_system(Qbinary);
|
|
|
110 }
|
|
|
111 }
|
|
|
112 else
|
|
|
113 {
|
|
|
114 coding_system = Ffind_coding_system (coding);
|
|
|
115 if (NILP(coding_system))
|
|
|
116 {
|
|
|
117 if (NILP(error_me_not))
|
|
|
118 signal_simple_error("No such coding system", coding);
|
|
|
119 else
|
|
|
120 coding_system = Fget_coding_system(Qbinary); /* default to binary */
|
|
|
121 }
|
|
|
122 }
|
|
|
123 #endif
|
|
|
124
|
|
|
125 /* setup the out stream */
|
|
|
126 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
|
|
|
127 ostr = XLSTREAM (outstream);
|
|
|
128 deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr);
|
|
|
129 dstr = XLSTREAM (deststream);
|
|
|
130 #ifdef FILE_CODING
|
|
|
131 /* setup the conversion stream */
|
|
|
132 conv_out_stream = make_encoding_output_stream (ostr, coding_system);
|
|
|
133 costr = XLSTREAM (conv_out_stream);
|
|
|
134 GCPRO3 (instream, outstream, conv_out_stream);
|
|
|
135 #else
|
|
|
136 GCPRO2 (instream, outstream);
|
|
|
137 #endif
|
|
|
138
|
|
|
139 /* Get the data while doing the conversion */
|
|
|
140 while (1) {
|
|
|
141 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
|
|
|
142 int l;
|
|
|
143 if (!size_in_bytes)
|
|
|
144 break;
|
|
|
145 /* It does seem the flushes are necessary... */
|
|
|
146 #ifdef FILE_CODING
|
|
|
147 Lstream_write (costr, tempbuf, size_in_bytes);
|
|
|
148 Lstream_flush (costr);
|
|
|
149 #else
|
|
|
150 Lstream_write (ostr, tempbuf, size_in_bytes);
|
|
|
151 #endif
|
|
|
152 Lstream_flush (ostr);
|
|
|
153
|
|
|
154 /* Update the base64 output buffer */
|
|
|
155 for (l = 0; l < size_in_bytes; l++) {
|
|
|
156 bits += Dynarr_at(conversion_out_dynarr,l);
|
|
|
157 char_count++;
|
|
|
158 if (char_count == 3) {
|
|
|
159 static char obuf[4];
|
|
|
160 obuf[0] = alphabet[(bits >> 18)];
|
|
|
161 obuf[1] = alphabet[(bits >> 12) & 0x3f];
|
|
|
162 obuf[2] = alphabet[(bits >> 6) & 0x3f];
|
|
|
163 obuf[3] = alphabet[bits & 0x3f];
|
|
|
164
|
|
|
165 Lstream_write(dstr,obuf,sizeof(obuf));
|
|
|
166 cols += 4;
|
|
|
167 if (cols == 72) {
|
|
|
168 Lstream_write(dstr,"\n",sizeof(unsigned char));
|
|
|
169 cols = 0;
|
|
|
170 }
|
|
|
171 bits = char_count = 0;
|
|
|
172 } else {
|
|
|
173 bits <<= 8;
|
|
|
174 }
|
|
|
175 }
|
|
|
176 /* reset the dynarr */
|
|
|
177 Lstream_rewind(ostr);
|
|
|
178 }
|
|
|
179 Lstream_close (istr);
|
|
|
180 #ifdef FILE_CODING
|
|
|
181 Lstream_close (costr);
|
|
|
182 #endif
|
|
|
183 Lstream_close (ostr);
|
|
|
184
|
|
|
185 if (char_count != 0) {
|
|
|
186 bits <<= 16 - (8 * char_count);
|
|
|
187 Lstream_write(dstr,&alphabet[bits >> 18],sizeof(unsigned char));
|
|
|
188 Lstream_write(dstr,&alphabet[(bits >> 12) & 0x3f],sizeof(unsigned char));
|
|
|
189 if (char_count == 1) {
|
|
|
190 Lstream_write(dstr,"==",2 * sizeof(unsigned char));
|
|
|
191 } else {
|
|
|
192 Lstream_write(dstr,&alphabet[(bits >> 6) & 0x3f],sizeof(unsigned char));
|
|
|
193 Lstream_write(dstr,"=",sizeof(unsigned char));
|
|
|
194 }
|
|
|
195 }
|
|
|
196 #if 0
|
|
|
197 if (cols > 0) {
|
|
|
198 Lstream_write(dstr,"\n",sizeof(unsigned char));
|
|
|
199 }
|
|
|
200 #endif
|
|
|
201 UNGCPRO;
|
|
|
202 Lstream_delete (istr);
|
|
|
203 Lstream_delete (ostr);
|
|
|
204 #ifdef FILE_CODING
|
|
|
205 Lstream_delete (costr);
|
|
|
206 #endif
|
|
|
207 Lstream_flush(dstr);
|
|
|
208 Lstream_delete(dstr);
|
|
|
209
|
|
|
210 return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr)));
|
|
|
211 }
|
|
|
212
|
|
|
213 DEFUN ("base64-decode", Fbase64_decode, 1, 5, 0, /*
|
|
|
214 Undo the base64 encoding of an object.
|
|
|
215 OBJECT is either a string or a buffer.
|
|
|
216 Optional arguments START and END denote buffer positions for computing the
|
|
|
217 hash of a portion of OBJECT. The optional CODING argument specifies the coding
|
|
|
218 system the text is to be represented in while computing the digest. This only
|
|
|
219 has meaning with MULE, and defaults to the current format of the data.
|
|
|
220 If ERROR-ME-NOT is nil, report an error if the coding system can't be
|
|
|
221 determined. Else assume binary coding if all else fails.
|
|
|
222 */
|
|
|
223 (object, start, end, coding, error_me_not))
|
|
|
224 {
|
|
|
225 static char inalphabet[256], decoder[256];
|
|
|
226 int i,cols,bits,char_count,hit_eof;
|
|
|
227 Lisp_Object instream, outstream,deststream;
|
|
|
228 Lstream *istr, *ostr, *dstr;
|
|
|
229 static Extbyte_dynarr *conversion_out_dynarr;
|
|
|
230 static Extbyte_dynarr *out_dynarr;
|
|
|
231 char tempbuf[1024]; /* some random amount */
|
|
|
232 struct gcpro gcpro1, gcpro2;
|
|
|
233 #ifdef FILE_CODING
|
|
|
234 Lisp_Object conv_out_stream, coding_system;
|
|
|
235 Lstream *costr;
|
|
|
236 struct gcpro gcpro3;
|
|
|
237 #endif
|
|
|
238
|
|
|
239 for (i = (sizeof alphabet) - 1; i >= 0 ; i--) {
|
|
|
240 inalphabet[alphabet[i]] = 1;
|
|
|
241 decoder[alphabet[i]] = i;
|
|
|
242 }
|
|
|
243
|
|
|
244 if (!conversion_out_dynarr)
|
|
|
245 conversion_out_dynarr = Dynarr_new (Extbyte);
|
|
|
246 else
|
|
|
247 Dynarr_reset (conversion_out_dynarr);
|
|
|
248
|
|
|
249 if (!out_dynarr)
|
|
|
250 out_dynarr = Dynarr_new(Extbyte);
|
|
|
251 else
|
|
|
252 Dynarr_reset (out_dynarr);
|
|
|
253
|
|
|
254 char_count = bits = cols = hit_eof = 0;
|
|
|
255
|
|
|
256 /* set up the in stream */
|
|
|
257 if (BUFFERP (object))
|
|
|
258 {
|
|
|
259 struct buffer *b = decode_buffer (object, 1);
|
|
|
260 Bufpos begv, endv;
|
|
|
261 /* Figure out where we need to get info from */
|
|
|
262 get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL);
|
|
|
263
|
|
|
264 instream = make_lisp_buffer_input_stream (b, begv, endv, 0);
|
|
|
265 }
|
|
|
266 else
|
|
|
267 {
|
|
|
268 Bytecount bstart, bend;
|
|
|
269 CHECK_STRING (object);
|
|
|
270 get_string_range_byte (object, start, end, &bstart, &bend,
|
|
|
271 GB_HISTORICAL_STRING_BEHAVIOR);
|
|
|
272 instream = make_lisp_string_input_stream (object, bstart, bend);
|
|
|
273 }
|
|
|
274 istr = XLSTREAM (instream);
|
|
|
275
|
|
|
276 #ifdef FILE_CODING
|
|
|
277 /* Find out what format the buffer will be saved in, so we can make
|
|
|
278 the digest based on what it will look like on disk */
|
|
|
279 if (NILP(coding))
|
|
|
280 {
|
|
|
281 if (BUFFERP(object))
|
|
|
282 {
|
|
|
283 /* Use the file coding for this buffer by default */
|
|
|
284 coding_system = XBUFFER(object)->buffer_file_coding_system;
|
|
|
285 }
|
|
|
286 else
|
|
|
287 {
|
|
|
288 /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */
|
|
|
289 enum eol_type eol = EOL_AUTODETECT;
|
|
|
290 coding_system = Fget_coding_system(Qundecided);
|
|
|
291 determine_real_coding_system(istr, &coding_system, &eol);
|
|
|
292 }
|
|
|
293 if (NILP(coding_system))
|
|
|
294 coding_system = Fget_coding_system(Qbinary);
|
|
|
295 else
|
|
|
296 {
|
|
|
297 coding_system = Ffind_coding_system (coding_system);
|
|
|
298 if (NILP(coding_system))
|
|
|
299 coding_system = Fget_coding_system(Qbinary);
|
|
|
300 }
|
|
|
301 }
|
|
|
302 else
|
|
|
303 {
|
|
|
304 coding_system = Ffind_coding_system (coding);
|
|
|
305 if (NILP(coding_system))
|
|
|
306 {
|
|
|
307 if (NILP(error_me_not))
|
|
|
308 signal_simple_error("No such coding system", coding);
|
|
|
309 else
|
|
|
310 coding_system = Fget_coding_system(Qbinary); /* default to binary */
|
|
|
311 }
|
|
|
312 }
|
|
|
313 #endif
|
|
|
314
|
|
|
315 /* setup the out stream */
|
|
|
316 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
|
|
|
317 ostr = XLSTREAM (outstream);
|
|
|
318 deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr);
|
|
|
319 dstr = XLSTREAM (deststream);
|
|
|
320 #ifdef FILE_CODING
|
|
|
321 /* setup the conversion stream */
|
|
|
322 conv_out_stream = make_encoding_output_stream (ostr, coding_system);
|
|
|
323 costr = XLSTREAM (conv_out_stream);
|
|
|
324 GCPRO3 (instream, outstream, conv_out_stream);
|
|
|
325 #else
|
|
|
326 GCPRO2 (instream, outstream);
|
|
|
327 #endif
|
|
|
328
|
|
|
329 /* Get the data while doing the conversion */
|
|
|
330 while (1) {
|
|
|
331 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
|
|
|
332 int l;
|
|
|
333 if (!size_in_bytes) {
|
|
|
334 hit_eof = 1;
|
|
|
335 break;
|
|
|
336 }
|
|
|
337 /* It does seem the flushes are necessary... */
|
|
|
338 #ifdef FILE_CODING
|
|
|
339 Lstream_write (costr, tempbuf, size_in_bytes);
|
|
|
340 Lstream_flush (costr);
|
|
|
341 #else
|
|
|
342 Lstream_write (ostr, tempbuf, size_in_bytes);
|
|
|
343 #endif
|
|
|
344 Lstream_flush (ostr);
|
|
|
345
|
|
|
346 /* Update the base64 output buffer */
|
|
|
347 for (l = 0; l < size_in_bytes; l++) {
|
|
|
348 if (Dynarr_at(conversion_out_dynarr,l) == '=')
|
|
|
349 goto decoder_out;
|
|
|
350 bits += decoder[Dynarr_at(conversion_out_dynarr,l)];
|
|
|
351 fprintf(stderr,"%d\n",bits);
|
|
|
352 char_count++;
|
|
|
353 if (char_count == 4) {
|
|
|
354 static unsigned char obuf[3];
|
|
|
355 obuf[0] = (bits >> 16);
|
|
|
356 obuf[1] = (bits >> 8) & 0xff;
|
|
|
357 obuf[2] = (bits & 0xff);
|
|
|
358
|
|
|
359 Lstream_write(dstr,obuf,sizeof(obuf));
|
|
|
360 bits = char_count = 0;
|
|
|
361 } else {
|
|
|
362 bits <<= 6;
|
|
|
363 }
|
|
|
364 }
|
|
|
365 /* reset the dynarr */
|
|
|
366 Lstream_rewind(ostr);
|
|
|
367 }
|
|
|
368 decoder_out:
|
|
|
369 Lstream_close (istr);
|
|
|
370 #ifdef FILE_CODING
|
|
|
371 Lstream_close (costr);
|
|
|
372 #endif
|
|
|
373 Lstream_close (ostr);
|
|
|
374
|
|
|
375 if (hit_eof) {
|
|
|
376 if (char_count) {
|
|
|
377 error_with_frob(object,"base64-decode failed: at least %d bits truncated",((4 - char_count) * 6));
|
|
|
378 }
|
|
|
379 }
|
|
|
380 switch(char_count) {
|
|
|
381 case 1:
|
|
|
382 error_with_frob(object, "base64 encoding incomplete: at least 2 bits missing");
|
|
|
383 break;
|
|
|
384 case 2:
|
|
|
385 char_count = bits >> 10;
|
|
|
386 Lstream_write(dstr,&char_count,sizeof(char_count));
|
|
|
387 break;
|
|
|
388 case 3:
|
|
|
389 {
|
|
|
390 unsigned char buf[2];
|
|
|
391 buf[0] = (bits >> 16);
|
|
|
392 buf[1] = (bits >> 8) & 0xff;
|
|
|
393 Lstream_write(dstr,buf,sizeof(buf));
|
|
|
394 break;
|
|
|
395 }
|
|
|
396 }
|
|
|
397
|
|
|
398 UNGCPRO;
|
|
|
399 Lstream_delete (istr);
|
|
|
400 Lstream_delete (ostr);
|
|
|
401 #ifdef FILE_CODING
|
|
|
402 Lstream_delete (costr);
|
|
|
403 #endif
|
|
|
404 Lstream_flush(dstr);
|
|
|
405 Lstream_delete(dstr);
|
|
|
406
|
|
|
407 return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr)));
|
|
|
408 }
|
|
|
409
|
|
|
410 void
|
|
388
|
411 syms_of_base64 (void)
|
|
265
|
412 {
|
|
|
413 DEFSUBR(Fbase64_encode);
|
|
|
414 DEFSUBR(Fbase64_decode);
|
|
|
415 }
|
|
|
416
|
|
|
417 void
|
|
388
|
418 vars_of_base64 (void)
|
|
265
|
419 {
|
|
|
420 Fprovide (intern ("base64"));
|
|
|
421 }
|
