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