unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* UUID3 implementation for Guile
@ 2018-01-08 14:58 pelzflorian (Florian Pelz)
  2018-01-08 15:47 ` pelzflorian (Florian Pelz)
  2018-01-09 10:00 ` Amirouche Boubekki
  0 siblings, 2 replies; 4+ messages in thread
From: pelzflorian (Florian Pelz) @ 2018-01-08 14:58 UTC (permalink / raw)
  To: guile-user

[-- Attachment #1: Type: text/plain, Size: 11545 bytes --]

Hello,

I need to generate a unique deterministic ID for Haunt and other Web
stuff.  Therefore I implemented UUID version 3 and MD5 by myself.  But
I wonder:

* Why is UUID3 support not in Guile proper?  Does it belong there?
  Should I submit a patch?

* Is there already a better implementation out there?  Apparently
  there is an implementation in Gauche Scheme.  I also find this.

  https://github.com/marcomaggi/industria/tree/master/weinholt

  Here the Guile list talked about using gcrypt from Guile.

  https://lists.gnu.org/archive/html/guile-devel/2013-02/msg00009.html


Regards,
Florian

P.S. If and only if you want to check it out, this is my current
implementation.  It should probably be made to accept messages from
ports instead of taking a complete bytevector as input.

(define-module (uuid)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 iconv)
  #:export (bytevector->md5
            make-version-3-uuid))

(define (bytevector->md5 bytevector)
  "Convert BYTEVECTOR to a bytevector containing the MD5 hash of
BYTEVECTOR."
  ;; Implemented along RFC 1321.  It should be easy to verify that
  ;; this procedure performs the operations specified therein.
  (define (append-padding-bits bytevector)
    "Makes a list from BYTEVECTOR with padding as per RFC 1321 3.1."
    (let* ((length-in-bits (* 8 (bytevector-length bytevector)))
           (padding-bits (- 512 (modulo (- length-in-bits 448) 512))))
      (append (bytevector->u8-list bytevector)
              '(128) ; #*10000000
              (iota
               (- (/ padding-bits 8) 1)
               0 0))))
  (define (append-length msg-list message-length)
    "Append MESSAGE-LENGTH as 8 byte values from a uint64 to MSG-LIST."
    (append msg-list
            ;; For numbers too large for an uint64, only the low-order
            ;; bytes are returned.
            (bytevector->u8-list (u64vector
                                  (modulo
                                   (* message-length 8) ; bits
                                   (1+ #xffffffffffffffff))))))
  (let hash ((AA #x67452301)
             (BB #xefcdab89)
             (CC #x98badcfe)
             (DD #x10325476)
             (to-digest
              (append-length
               (append-padding-bits
                bytevector)
               (bytevector-length bytevector))))
    (define (F X Y Z)
      (logior (logand X Y) (logand (lognot X) Z)))
    (define (G X Y Z)
      (logior (logand X Z) (logand Y (lognot Z))))
    (define (H X Y Z)
      (logxor X Y Z))
    (define (I X Y Z)
      (logxor Y (logior X (lognot Z))))
    (define (T i)
      (inexact->exact (floor (* 4294967296 (abs (sin i))))))
    (define (number->u32 n)
      "Cut off all bits that do not fit in a uint32."
      (bit-extract n 0 32))
    (define (lsh32 n count)
      (number->u32 (logior (ash n count)
                           (bit-extract n (- 32 count) 32))))
    (if (not (null? to-digest))
        (let* ((block (u8-list->bytevector
                       (list-head to-digest (/ 512 8))))
               (X (lambda (j) (bytevector-u32-ref
                               block (* 4 j) (endianness little))))
               (do-round1
                (lambda (A B C D)
                  (define (operation a b c d k s i)
                    (number->u32
                     (+ b (lsh32 (+ a (F b c d) (X k) (T i)) s))))
                  (let* ((A (operation A B C D 0 7 1))
                         (D (operation D A B C 1 12 2))
                         (C (operation C D A B 2 17 3))
                         (B (operation B C D A 3 22 4))
                         (A (operation A B C D 4 7 5))
                         (D (operation D A B C 5 12 6))
                         (C (operation C D A B 6 17 7))
                         (B (operation B C D A 7 22 8))
                         (A (operation A B C D 8 7 9))
                         (D (operation D A B C 9 12 10))
                         (C (operation C D A B 10 17 11))
                         (B (operation B C D A 11 22 12))
                         (A (operation A B C D 12 7 13))
                         (D (operation D A B C 13 12 14))
                         (C (operation C D A B 14 17 15))
                         (B (operation B C D A 15 22 16)))
                    (values A B C D))))
               (do-round2
                (lambda (A B C D)
                  (define (operation a b c d k s i)
                    (number->u32
                     (+ b (lsh32 (+ a (G b c d) (X k) (T i)) s))))
                  (let* ((A (operation A B C D 1 5 17))
                         (D (operation D A B C 6 9 18))
                         (C (operation C D A B 11 14 19))
                         (B (operation B C D A 0 20 20))
                         (A (operation A B C D 5 5 21))
                         (D (operation D A B C 10 9 22))
                         (C (operation C D A B 15 14 23))
                         (B (operation B C D A 4 20 24))
                         (A (operation A B C D 9 5 25))
                         (D (operation D A B C 14 9 26))
                         (C (operation C D A B 3 14 27))
                         (B (operation B C D A 8 20 28))
                         (A (operation A B C D 13 5 29))
                         (D (operation D A B C 2 9 30))
                         (C (operation C D A B 7 14 31))
                         (B (operation B C D A 12 20 32)))
                    (values A B C D))))
               (do-round3
                (lambda (A B C D)
                  (define (operation a b c d k s i)
                    (number->u32
                     (+ b (lsh32 (+ a (H b c d) (X k) (T i)) s))))
                  (let* ((A (operation A B C D 5 4 33))
                         (D (operation D A B C 8 11 34))
                         (C (operation C D A B 11 16 35))
                         (B (operation B C D A 14 23 36))
                         (A (operation A B C D 1 4 37))
                         (D (operation D A B C 4 11 38))
                         (C (operation C D A B 7 16 39))
                         (B (operation B C D A 10 23 40))
                         (A (operation A B C D 13 4 41))
                         (D (operation D A B C 0 11 42))
                         (C (operation C D A B 3 16 43))
                         (B (operation B C D A 6 23 44))
                         (A (operation A B C D 9 4 45))
                         (D (operation D A B C 12 11 46))
                         (C (operation C D A B 15 16 47))
                         (B (operation B C D A 2 23 48)))
                    (values A B C D))))
               (do-round4
                (lambda (A B C D)
                  (define (operation a b c d k s i)
                    (number->u32
                     (+ b (lsh32 (+ a (I b c d) (X k) (T i)) s))))
                  (let* ((A (operation A B C D 0 6 49))
                         (D (operation D A B C 7 10 50))
                         (C (operation C D A B 14 15 51))
                         (B (operation B C D A 5 21 52))
                         (A (operation A B C D 12 6 53))
                         (D (operation D A B C 3 10 54))
                         (C (operation C D A B 10 15 55))
                         (B (operation B C D A 1 21 56))
                         (A (operation A B C D 8 6 57))
                         (D (operation D A B C 15 10 58))
                         (C (operation C D A B 6 15 59))
                         (B (operation B C D A 13 21 60))
                         (A (operation A B C D 4 6 61))
                         (D (operation D A B C 11 10 62))
                         (C (operation C D A B 2 15 63))
                         (B (operation B C D A 9 21 64)))
                    (values A B C D)))))
          (let*-values (((A B C D) (values AA BB CC DD))
                        ((A B C D) (do-round1 A B C D))
                        ((A B C D) (do-round2 A B C D))
                        ((A B C D) (do-round3 A B C D))
                        ((A B C D) (do-round4 A B C D)))
            (hash (number->u32 (+ A AA))
                  (number->u32 (+ B BB))
                  (number->u32 (+ C CC))
                  (number->u32 (+ D DD))
                  (list-tail to-digest (/ 512 8)))))
        ;; we’re done:
        (u8-list->bytevector
         (append
          (bytevector->u8-list (u32vector AA))
          (bytevector->u8-list (u32vector BB))
          (bytevector->u8-list (u32vector CC))
          (bytevector->u8-list (u32vector DD)))))))

(define (make-version-3-uuid namespace-uuid str)
  "Generates a UUID string by computing the MD5 hash of NAMESPACE-UUID
and STR.  NAMESPACE-UUID must be a bytevector consisting of the UUID’s
bytes, *not* the UUID’s string representation."
  (define (half-byte->hex-char number)
    "Returns the corresponding hexadecimal digit for a number NUMBER
between 0 and 15."
    (case number
      ((0) #\0)
      ((1) #\1)
      ((2) #\2)
      ((3) #\3)
      ((4) #\4)
      ((5) #\5)
      ((6) #\6)
      ((7) #\7)
      ((8) #\8)
      ((9) #\9)
      ((10) #\a)
      ((11) #\b)
      ((12) #\c)
      ((13) #\d)
      ((14) #\e)
      ((15) #\f)))
  (define (byte->hex-string bv index)
    "Convert the byte at INDEX of bytevector BV to a hex string."
    (let ((byte (bytevector-u8-ref bv index)))
      (string (half-byte->hex-char (quotient byte 16))
              (half-byte->hex-char (modulo byte 16)))))
  (let ((md5 (bytevector->md5
              (u8-list->bytevector
               (append (bytevector->u8-list namespace-uuid)
                       (bytevector->u8-list (string->utf8 str)))))))
    (string-append "urn:uuid:"
                   ;; time_low field:
                   (byte->hex-string md5 0)
                   (byte->hex-string md5 1)
                   (byte->hex-string md5 2)
                   (byte->hex-string md5 3)
                   "-"
                   ;; time_mid field:
                   (byte->hex-string md5 4)
                   (byte->hex-string md5 5)
                   "-"
                   ;; time_hi_and_version field:
                   (let ((byte (bytevector-u8-ref md5 6)))
                     (string (half-byte->hex-char 3) ; UUID version 3
                             (half-byte->hex-char (modulo byte 16))))
                   (byte->hex-string md5 7)
                   "-"
                   ;; clock_seq_hi_and_reserved field:
                   (let ((byte (bytevector-u8-ref md5 8)))
                     (string (half-byte->hex-char
                              (logior #b1000 ; most significant bits are 10
                                      (bit-extract (quotient byte 16) 0 2)))
                             (half-byte->hex-char (modulo byte 16))))
                   ;; clock_seq_low field:
                   (byte->hex-string md5 9)
                   "-"
                   ;; node field:
                   (byte->hex-string md5 10)
                   (byte->hex-string md5 11)
                   (byte->hex-string md5 12)
                   (byte->hex-string md5 13)
                   (byte->hex-string md5 14)
                   (byte->hex-string md5 15))))

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: UUID3 implementation for Guile
  2018-01-08 14:58 UUID3 implementation for Guile pelzflorian (Florian Pelz)
@ 2018-01-08 15:47 ` pelzflorian (Florian Pelz)
  2018-01-09 10:00 ` Amirouche Boubekki
  1 sibling, 0 replies; 4+ messages in thread
From: pelzflorian (Florian Pelz) @ 2018-01-08 15:47 UTC (permalink / raw)
  To: guile-user

[-- Attachment #1: Type: text/plain, Size: 736 bytes --]

On Mon, Jan 08, 2018 at 03:58:01PM +0100, pelzflorian (Florian Pelz) wrote:
> P.S. If and only if you want to check it out, this is my current
> implementation.  It should probably be made to accept messages from
> ports instead of taking a complete bytevector as input.
> 

I forgot to mention;

(use-modules (uuid)
             (rnrs bytevectors))

(display
 (make-version-3-uuid
  (u8-list->bytevector
   ;; URL namespace UUID is 6ba7b811-9dad-11d1-80b4-00c04fd430c8
   '(#x6b #xa7 #xb8 #x11 #x9d #xad #x11 #xd1 #x80 #xb4
          #x00 #xc0 #x4f #xd4 #x30 #xc8))
  "https://example.org"))
(newline)

yields the same result as Python’s

import uuid
uuid.uuid3(uuid.NAMESPACE_URL, 'https://example.org')



[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: UUID3 implementation for Guile
  2018-01-08 14:58 UUID3 implementation for Guile pelzflorian (Florian Pelz)
  2018-01-08 15:47 ` pelzflorian (Florian Pelz)
@ 2018-01-09 10:00 ` Amirouche Boubekki
  2018-01-09 13:29   ` pelzflorian (Florian Pelz)
  1 sibling, 1 reply; 4+ messages in thread
From: Amirouche Boubekki @ 2018-01-09 10:00 UTC (permalink / raw)
  To: pelzflorian (Florian Pelz); +Cc: guile-user, guile-user

Le 2018-01-08 15:58, pelzflorian (Florian Pelz) a écrit :
> Hello,
> 
> I need to generate a unique deterministic ID for Haunt and other Web
> stuff.  Therefore I implemented UUID version 3 and MD5 by myself.  But
> I wonder:
> 
> * Why is UUID3 support not in Guile proper?  Does it belong there?
>   Should I submit a patch?

It definitly has a place in Guile, if it's not already provided by
another GNU project like libgcrypt or gnutls. You need to patch
branch-2.2 with your code, tests and documentation and send the
patch to guile-devel@gnu.org.

> * Is there already a better implementation out there?  Apparently
>   there is an implementation in Gauche Scheme.  I also find this.
> 
>   https://github.com/marcomaggi/industria/tree/master/weinholt

The official repository for industria is the following:

   https://github.com/weinholt/industria/

I use some of those in my web projects, including argon2

   
https://github.com/a-guile-mind/culturia.one/blob/master/src/argon2.scm

I think you'd better avoid both md5 and sha1 because there
are attacks against them.

>   Here the Guile list talked about using gcrypt from Guile.
> 
>   https://lists.gnu.org/archive/html/guile-devel/2013-02/msg00009.html
> 

I think it's better to rely on libgcrypt and gnutls. I don't
do that myself, yet, because industria is the easy solution.

The problem with industria is that we are not sure it's used
by people and that the cryptography is correct. Whereas libgcrypt
and gnutls have a much wider audience with less chances of bugs
and compromissions.

Can you explain how do you use md5 and uuid3 with haunt?

FWIW I would prefer to use something base62, instead of exposing
a md5 hash directly.



^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: UUID3 implementation for Guile
  2018-01-09 10:00 ` Amirouche Boubekki
@ 2018-01-09 13:29   ` pelzflorian (Florian Pelz)
  0 siblings, 0 replies; 4+ messages in thread
From: pelzflorian (Florian Pelz) @ 2018-01-09 13:29 UTC (permalink / raw)
  To: Amirouche Boubekki; +Cc: guile-user, guile-user

[-- Attachment #1: Type: text/plain, Size: 1218 bytes --]

On Tue, Jan 09, 2018 at 11:00:26AM +0100, Amirouche Boubekki wrote:
> […]
> I think it's better to rely on libgcrypt and gnutls. I don't
> do that myself, yet, because industria is the easy solution.
> 
> The problem with industria is that we are not sure it's used
> by people and that the cryptography is correct. Whereas libgcrypt
> and gnutls have a much wider audience with less chances of bugs
> and compromissions.
> 

Rereading the old thread, if there are not any new options I will use
gcrypt with some sort of FFI.  Thank you!

> Can you explain how do you use md5 and uuid3 with haunt?
> 
> FWIW I would prefer to use something base62, instead of exposing
> a md5 hash directly.

I need to automatically generate unique ids for Haunt’s Atom feeds and
for the CSS of a non-JavaScript sortable HTML table (i.e. multiple
variants of the same table between which one can switch with CSS).
The automatic generation should be deterministic so the page does not
change when rebuilding the Web site.  That is why I wanted to use
UUID3 for it.  I thought security need not be considered here but who
knows, maybe I should just use a secure hash instead of a UUID.

Regards,
Florian

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2018-01-09 13:29 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-01-08 14:58 UUID3 implementation for Guile pelzflorian (Florian Pelz)
2018-01-08 15:47 ` pelzflorian (Florian Pelz)
2018-01-09 10:00 ` Amirouche Boubekki
2018-01-09 13:29   ` pelzflorian (Florian Pelz)

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).