comparison src/md5.c @ 249:83b3d10dcba9 r20-5b23

Import from CVS: tag r20-5b23
author cvs
date Mon, 13 Aug 2007 10:19:09 +0200
parents 8eaf7971accc
children 11cf20601dec
comparison
equal deleted inserted replaced
248:ad40ac2754d8 249:83b3d10dcba9
22 These notices must be retained in any copies of any part of this 22 These notices must be retained in any copies of any part of this
23 documentation and/or software. 23 documentation and/or software.
24 */ 24 */
25 25
26 /* Synched up with: Not in FSF. */ 26 /* Synched up with: Not in FSF. */
27 /* This file has been Mule-ized. See comment at Fmd5(), though. */ 27 /* This file has been Mule-ized. */
28 28
29 #include <config.h> 29 #include <config.h>
30 #include "lisp.h" 30 #include "lisp.h"
31 31
32 #include "buffer.h" 32 #include "buffer.h"
33 #include "insdel.h" 33 #include "insdel.h"
34 #include "lstream.h"
35 #ifdef MULE
36 #include "mule-coding.h"
37 #endif
34 38
35 typedef unsigned char *POINTER;/* POINTER defines a generic pointer type */ 39 typedef unsigned char *POINTER;/* POINTER defines a generic pointer type */
36 typedef unsigned short int UINT2;/* UINT2 defines a two byte word */ 40 typedef unsigned short int UINT2;/* UINT2 defines a two byte word */
37 typedef unsigned int UINT4;/* UINT4 defines a four byte word */ 41 typedef unsigned int UINT4;/* UINT4 defines a four byte word */
38 42
353 357
354 358
355 /* XEmacs interface code. */ 359 /* XEmacs interface code. */
356 Lisp_Object Qmd5; 360 Lisp_Object Qmd5;
357 361
358 /* #### There could be potential problems here with Mule. I don't 362 DEFUN ("md5", Fmd5, 1, 5, 0, /*
359 know enough about the uses of MD5 to be able to tell for sure
360 whether this is a problem. The basic potential problem is that
361 the hash value will be computed based on the internal representation
362 of the buffer; this would likely cause problems if the string
363 contains extended characters, because the extended characters
364 will get sent over the wire in an external form that is different
365 from their internal representation, and thus their MD5 hash would
366 be different. */
367
368 DEFUN ("md5", Fmd5, 1, 3, 0, /*
369 Return the MD5 (a secure message digest algorithm) of an object. 363 Return the MD5 (a secure message digest algorithm) of an object.
370 OBJECT is either a string or a buffer. 364 OBJECT is either a string or a buffer.
371 Optional arguments START and END denote buffer positions for computing the 365 Optional arguments START and END denote buffer positions for computing the
372 hash of a portion of OBJECT. 366 hash of a portion of OBJECT. The optional CODING argument specifies the coding
367 system the text is to be represented in while computing the digest. This only
368 has meaning with MULE, and defaults to the current format of the data.
369 If ERROR-ME-NOT is nil, report an error if the coding system can't be
370 determined. Else assume binary coding if all else fails.
373 */ 371 */
374 (object, start, end)) 372 (object, start, end, coding, error_me_not))
375 { 373 {
374 /* This function can GC */
376 MD_CTX context; 375 MD_CTX context;
377 unsigned char digest[16]; 376 unsigned char digest[16];
378 unsigned char thehash[32]; 377 unsigned char thehash[32];
379 int i; 378 int i;
380 379
382 381
383 if (NILP (object)) 382 if (NILP (object))
384 { 383 {
385 MDUpdate (&context, (CONST unsigned char *) "", 0); 384 MDUpdate (&context, (CONST unsigned char *) "", 0);
386 } 385 }
387 else if (BUFFERP (object))
388 {
389 struct buffer *b = decode_buffer (object, 1);
390 Bufpos begv, endv;
391 Lisp_Object string;
392
393 /* Figure out where we need to get info from */
394 get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL);
395
396 /* Get the string data from the buffer */
397 string = make_string_from_buffer (b, begv, endv - begv);
398
399 /* Compute the digest */
400 MDUpdate (&context, (unsigned char *) XSTRING_DATA (string),
401 XSTRING_LENGTH (string));
402 }
403 else 386 else
404 { 387 {
405 Bytecount len, bstart, bend; 388 Lisp_Object instream, outstream;
406 CHECK_STRING (object); 389 Lstream *istr, *ostr;
407 get_string_range_byte (object, start, end, &bstart, &bend, 390 static Extbyte_dynarr *conversion_out_dynarr;
408 GB_HISTORICAL_STRING_BEHAVIOR); 391 char tempbuf[1024]; /* some random amount */
409 len = bend - bstart; 392 struct gcpro gcpro1, gcpro2;
410 MDUpdate (&context, ((unsigned char *) XSTRING_DATA (object) 393 #ifdef MULE
411 + bstart), len); 394 Lisp_Object conv_out_stream, coding_system;
395 Lstream *costr;
396 struct gcpro gcpro3;
397 #endif
398
399 if (!conversion_out_dynarr)
400 conversion_out_dynarr = Dynarr_new (Extbyte);
401 else
402 Dynarr_reset (conversion_out_dynarr);
403
404 /* set up the in stream */
405 if (BUFFERP (object))
406 {
407 struct buffer *b = decode_buffer (object, 1);
408 Bufpos begv, endv;
409 /* Figure out where we need to get info from */
410 get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL);
411
412 instream = make_lisp_buffer_input_stream (b, begv, endv, 0);
413 }
414 else
415 {
416 Bytecount bstart, bend;
417 CHECK_STRING (object);
418 get_string_range_byte (object, start, end, &bstart, &bend,
419 GB_HISTORICAL_STRING_BEHAVIOR);
420 instream = make_lisp_string_input_stream (object, bstart, bend);
421 }
422 istr = XLSTREAM (instream);
423
424 #ifdef MULE
425 /* Find out what format the buffer will be saved in, so we can make
426 the digest based on what it will look like on disk */
427 if (NILP(coding))
428 {
429 if (BUFFERP(object))
430 {
431 /* Use the file coding for this buffer by default */
432 coding_system = XBUFFER(object)->buffer_file_coding_system;
433 }
434 else
435 {
436 /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */
437 enum eol_type eol = EOL_AUTODETECT;
438 coding_system = Fget_coding_system(Qundecided);
439 determine_real_coding_system(istr, &coding_system, &eol);
440 }
441 if (NILP(coding_system))
442 coding_system = Fget_coding_system(Qbinary);
443 else
444 {
445 coding_system = Ffind_coding_system (coding_system);
446 if (NILP(coding_system))
447 coding_system = Fget_coding_system(Qbinary);
448 }
449 }
450 else
451 {
452 coding_system = Ffind_coding_system (coding);
453 if (NILP(coding_system))
454 if (NILP(error_me_not))
455 signal_simple_error("No such coding system", coding);
456 else
457 coding_system = Fget_coding_system(Qbinary); /* default to binary */
458 }
459 #endif
460
461 /* setup the out stream */
462 outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
463 ostr = XLSTREAM (outstream);
464 #ifdef MULE
465 /* setup the conversion stream */
466 conv_out_stream = make_encoding_output_stream (ostr, coding_system);
467 costr = XLSTREAM (conv_out_stream);
468 GCPRO3 (instream, outstream, conv_out_stream);
469 #else
470 GCPRO2 (instream, outstream);
471 #endif
472
473 /* Get the data while doing the conversion */
474 while (1) {
475 int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
476 if (!size_in_bytes)
477 break;
478 /* It does seem the flushes are necessary... */
479 #ifdef MULE
480 Lstream_write (costr, tempbuf, size_in_bytes);
481 Lstream_flush (costr);
482 #else
483 Lstream_write (ostr, tempbuf, size_in_bytes);
484 #endif
485 Lstream_flush (ostr);
486
487 /* Update the digest */
488
489 MDUpdate (&context, (unsigned char *)Dynarr_atp(conversion_out_dynarr, 0),
490 Dynarr_length(conversion_out_dynarr));
491 /* reset the dynarr */
492 Lstream_rewind(ostr);
493 }
494 Lstream_close (istr);
495 #ifdef MULE
496 Lstream_close (costr);
497 #endif
498 Lstream_close (ostr);
499
500 UNGCPRO;
501 Lstream_delete (istr);
502 Lstream_delete (ostr);
503 #ifdef MULE
504 Lstream_delete (costr);
505 #endif
412 } 506 }
413 507
414 MDFinal (digest, &context); 508 MDFinal (digest, &context);
415 for (i = 0; i < 16; i++) 509 for (i = 0; i < 16; i++)
416 sprintf ((char *) (thehash + (i * 2)), "%02x", digest[i]); 510 sprintf ((char *) (thehash + (i * 2)), "%02x", digest[i]);