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