git.chise.org Git - chise/xemacs-chise.git.1/blob - modules/base64/base64.c

   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 }