XEmacs 21.2.9
[chise/xemacs-chise.git.1] / modules / base64 / base64.c
1 /* base64 interface for XEmacs.
2    Copyright (C) 1998, 1999 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 <emodules.h>
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
411 syms_of_base64 (void)
412 {
413   DEFSUBR(Fbase64_encode);
414   DEFSUBR(Fbase64_decode);
415 }
416
417 void
418 vars_of_base64 (void)
419 {
420   Fprovide (intern ("base64"));
421 }