code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2013, 2014, 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gcrypt pk-crypto)
  #:use-module (gcrypt base16)
  #:use-module (gcrypt internal)
  #:use-module (gcrypt common)
  #:use-module (system foreign)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:export (canonical-sexp?
            string->canonical-sexp
            canonical-sexp->string
            read-file-sexp
            number->canonical-sexp
            canonical-sexp-car
            canonical-sexp-cdr
            canonical-sexp-nth
            canonical-sexp-nth-data
            canonical-sexp-length
            canonical-sexp-null?
            canonical-sexp-list?
            bytevector->hash-data
            hash-data->bytevector
            key-type
            sign
            verify
            generate-key
            find-sexp-token
            canonical-sexp->sexp
            sexp->canonical-sexp)
  #:re-export (gcrypt-version))

;;; Commentary:
;;;
;;; Public key cryptographic routines from GNU Libgcrypt.
;;;;
;;; Libgcrypt uses "canonical s-expressions" to represent key material,
;;; parameters, and data.  We keep it as an opaque object to map them to
;;; Scheme s-expressions because (1) Libgcrypt sexps may be stored in secure
;;; memory, and (2) the read syntax is different.
;;;
;;; A 'canonical-sexp->sexp' procedure is provided nevertheless, for use in
;;; cases where it is safe to move data out of Libgcrypt---e.g., when
;;; processing ACL entries, public keys, etc.
;;;
;;; Canonical sexps were defined by Rivest et al. in the IETF draft at
;;; <http://people.csail.mit.edu/rivest/Sexp.txt> for the purposes of SPKI
;;; (see <http://www.ietf.org/rfc/rfc2693.txt>.)
;;;
;;; Code:

;; Libgcrypt "s-expressions".
(define-wrapped-pointer-type <canonical-sexp>
  canonical-sexp?
  naked-pointer->canonical-sexp
  canonical-sexp->pointer
  (lambda (obj port)
    ;; Don't print OBJ's external representation: we don't want key material
    ;; to leak in backtraces and such.
    (format port "#<canonical-sexp ~a | ~a>"
            (number->string (object-address obj) 16)
            (number->string (pointer-address (canonical-sexp->pointer obj))
                            16))))

(define finalize-canonical-sexp!
  (libgcrypt->pointer "gcry_sexp_release"))

(define-inlinable (pointer->canonical-sexp ptr)
  "Return a <canonical-sexp> that wraps PTR."
  (let* ((sexp (naked-pointer->canonical-sexp ptr))
         (ptr* (canonical-sexp->pointer sexp)))
    ;; Did we already have a <canonical-sexp> object for PTR?
    (when (equal? ptr ptr*)
      ;; No, so we can safely add a finalizer (in Guile 2.0.9
      ;; 'set-pointer-finalizer!' *adds* a finalizer rather than replacing the
      ;; existing one.)
      (set-pointer-finalizer! ptr finalize-canonical-sexp!))
    sexp))

(define string->canonical-sexp
  (let ((proc (libgcrypt->procedure int
                                    "gcry_sexp_new"
                                    `(* * ,size_t ,int))))
    (lambda (str)
      "Parse STR and return the corresponding gcrypt s-expression."

      ;; When STR comes from 'canonical-sexp->string', it may contain
      ;; characters that are really meant to be interpreted as bytes as in a C
      ;; 'char *'.  Thus, convert STR to ISO-8859-1 so the byte values of the
      ;; characters are preserved.
      (let* ((sexp (bytevector->pointer (make-bytevector (sizeof '*))))
             (err  (proc sexp (string->pointer str "ISO-8859-1") 0 1)))
        (if (= 0 err)
            (pointer->canonical-sexp (dereference-pointer sexp))
            (throw 'gcry-error 'string->canonical-sexp err))))))

(define-syntax GCRYSEXP_FMT_ADVANCED
  (identifier-syntax 3))

(define canonical-sexp->string
  (let ((proc (libgcrypt->procedure size_t
                                    "gcry_sexp_sprint"
                                    `(* ,int * ,size_t))))
    (lambda (sexp)
      "Return a textual representation of SEXP."
      (let loop ((len 1024))
        (let* ((buf  (bytevector->pointer (make-bytevector len)))
               (size (proc (canonical-sexp->pointer sexp)
                           GCRYSEXP_FMT_ADVANCED buf len)))
          (if (zero? size)
              (loop (* len 2))
              (pointer->string buf size "ISO-8859-1")))))))

(define (read-file-sexp file)
  "Return the canonical sexp read from FILE."
  (call-with-input-file file
    (compose string->canonical-sexp
             read-string)))

(define canonical-sexp-car
  (let ((proc (libgcrypt->procedure '* "gcry_sexp_car" '(*))))
    (lambda (lst)
      "Return the first element of LST, an sexp, if that element is a list;
return #f if LST or its first element is not a list (this is different from
the usual Lisp 'car'.)"
      (let ((result (proc (canonical-sexp->pointer lst))))
        (if (null-pointer? result)
            #f
            (pointer->canonical-sexp result))))))

(define canonical-sexp-cdr
  (let ((proc (libgcrypt->procedure '* "gcry_sexp_cdr" '(*))))
    (lambda (lst)
      "Return the tail of LST, an sexp, or #f if LST is not a list."
      (let ((result (proc (canonical-sexp->pointer lst))))
        (if (null-pointer? result)
            #f
            (pointer->canonical-sexp result))))))

(define canonical-sexp-nth
  (let ((proc (libgcrypt->procedure '* "gcry_sexp_nth" `(* ,int))))
    (lambda (lst index)
      "Return the INDEXth nested element of LST, an s-expression.  Return #f
if that element does not exist, or if it's an atom.  (Note: this is obviously
different from Scheme's 'list-ref'.)"
      (let ((result (proc (canonical-sexp->pointer lst) index)))
        (if (null-pointer? result)
            #f
            (pointer->canonical-sexp result))))))

(define (dereference-size_t p)
  "Return the size_t value pointed to by P."
  (bytevector-uint-ref (pointer->bytevector p (sizeof size_t))
                       0 (native-endianness)
                       (sizeof size_t)))

(define canonical-sexp-length
  (let ((proc (libgcrypt->procedure int "gcry_sexp_length" '(*))))
    (lambda (sexp)
      "Return the length of SEXP if it's a list (including the empty list);
return zero if SEXP is an atom."
      (proc (canonical-sexp->pointer sexp)))))

(define token-string?
  (let ((token-cs (char-set-union char-set:digit
                                  char-set:letter
                                  (char-set #\- #\. #\/ #\_
                                            #\: #\* #\+ #\=))))
    (lambda (str)
      "Return #t if STR is a token as per Section 4.3 of
<http://people.csail.mit.edu/rivest/Sexp.txt>."
      (and (not (string-null? str))
           (string-every token-cs str)
           (not (char-set-contains? char-set:digit (string-ref str 0)))))))

(define canonical-sexp-nth-data
  (let ((proc (libgcrypt->procedure '* "gcry_sexp_nth_data" `(* ,int *))))
    (lambda (lst index)
      "Return as a symbol (for \"sexp tokens\") or a bytevector (for any other
\"octet string\") the INDEXth data element (atom) of LST, an s-expression.
Return #f if that element does not exist, or if it's a list."
      (let* ((size*  (bytevector->pointer (make-bytevector (sizeof '*))))
             (result (proc (canonical-sexp->pointer lst) index size*)))
        (if (null-pointer? result)
            #f
            (let* ((len (dereference-size_t size*))
                   (str (pointer->string result len "ISO-8859-1")))
              ;; The sexp spec speaks of "tokens" and "octet strings".
              ;; Sometimes these octet strings are actual strings (text),
              ;; sometimes they're bytevectors, and sometimes they're
              ;; multi-precision integers (MPIs).  Only the application knows.
              ;; However, for convenience, we return a symbol when a token is
              ;; encountered since tokens are frequent (at least in the 'car'
              ;; of each sexp.)
              (if (token-string? str)
                  (string->symbol str)   ; an sexp "token"
                  (bytevector-copy       ; application data, textual or binary
                   (pointer->bytevector result len)))))))))

(define (number->canonical-sexp number)
  "Return an s-expression representing NUMBER."
  (let ((hex-number
         (match (number->string number 16)
           ;; Append a 0 if necessary.  For whatever reason gcrypt
           ;; rejects hex numbers that don't have an even number of
           ;; digits.
           ((? (lambda (s) (odd? (string-length s))) odd-string)
            (string-append "0" odd-string))
           (even-str even-str))))
    (string->canonical-sexp (string-append "#" hex-number "#"))))

(define* (bytevector->hash-data bv
                                #:optional
                                (hash-algo "sha256")
                                #:key (key-type 'ecc))
  "Given BV, a bytevector containing a hash of type HASH-ALGO, return an
s-expression suitable for use as the 'data' argument for 'sign'.  KEY-TYPE
must be a symbol: 'dsa, 'ecc, or 'rsa."
  (string->canonical-sexp
   (format #f "(data (flags ~a) (hash \"~a\" #~a#))"
           (case key-type
             ((ecc dsa) "rfc6979")
             ((rsa)     "pkcs1")
             (else (error "unknown key type" key-type)))
           hash-algo
           (bytevector->base16-string bv))))

(define (key-type sexp)
  "Return a symbol denoting the type of public or private key represented by
SEXP--e.g., 'rsa', 'ecc'--or #f if SEXP does not denote a valid key."
  (case (canonical-sexp-nth-data sexp 0)
    ((public-key private-key)
     (canonical-sexp-nth-data (canonical-sexp-nth sexp 1) 0))
    (else #f)))

(define* (hash-data->bytevector data)
  "Return two values: the hash value (a bytevector), and the hash algorithm (a
string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'.
Return #f if DATA does not conform."
  (let ((hash (find-sexp-token data 'hash)))
    (if hash
        (let ((algo  (canonical-sexp-nth-data hash 1))
              (value (canonical-sexp-nth-data hash 2)))
          (values value (symbol->string algo)))
        (values #f #f))))

(define sign
  (let ((proc (libgcrypt->procedure int "gcry_pk_sign" '(* * *))))
    (lambda (data secret-key)
      "Sign DATA, a canonical s-expression representing a suitable hash, with
SECRET-KEY (a canonical s-expression whose car is 'private-key'.)  Note that
DATA must be a 'data' s-expression, as returned by
'bytevector->hash-data' (info \"(gcrypt) Cryptographic Functions\")."
      (let* ((sig (bytevector->pointer (make-bytevector (sizeof '*))))
             (err (proc sig (canonical-sexp->pointer data)
                        (canonical-sexp->pointer secret-key))))
        (if (= 0 err)
            (pointer->canonical-sexp (dereference-pointer sig))
            (throw 'gcry-error 'sign err))))))

(define verify
  (let ((proc (libgcrypt->procedure int "gcry_pk_verify" '(* * *))))
    (lambda (signature data public-key)
      "Verify that SIGNATURE is a signature of DATA with PUBLIC-KEY, all of
which are gcrypt s-expressions; return #t if the verification was successful,
#f otherwise.  Raise an error if, for example, one of the given s-expressions
is invalid."
      (let ((err (proc (canonical-sexp->pointer signature)
                       (canonical-sexp->pointer data)
                       (canonical-sexp->pointer public-key))))
        (cond ((zero? err) #t)
              ((error-code=? error/bad-signature err) #f)
              (else (throw 'gcry-error 'verify err)))))))

(define generate-key
  (let ((proc (libgcrypt->procedure int "gcry_pk_genkey" '(* *))))
    (lambda (params)
      "Return as an s-expression a new key pair for PARAMS.  PARAMS must be an
s-expression like: (genkey (rsa (nbits 4:2048)))."
      (let* ((key (bytevector->pointer (make-bytevector (sizeof '*))))
             (err (proc key (canonical-sexp->pointer params))))
        (if (zero? err)
            (pointer->canonical-sexp (dereference-pointer key))
            (throw 'gcry-error 'generate-key err))))))

(define find-sexp-token
  (let ((proc (libgcrypt->procedure '*
                                    "gcry_sexp_find_token"
                                    `(* * ,size_t))))
    (lambda (sexp token)
      "Find in SEXP the first element whose 'car' is TOKEN and return it;
return #f if not found."
      (let* ((token (string->pointer (symbol->string token)))
             (res   (proc (canonical-sexp->pointer sexp) token 0)))
        (if (null-pointer? res)
            #f
            (pointer->canonical-sexp res))))))

(define-inlinable (canonical-sexp-null? sexp)
  "Return #t if SEXP is the empty-list sexp."
  (null-pointer? (canonical-sexp->pointer sexp)))

(define (canonical-sexp-list? sexp)
  "Return #t if SEXP is a list."
  (or (canonical-sexp-null? sexp)
      (> (canonical-sexp-length sexp) 0)))

(define (canonical-sexp-fold proc seed sexp)
  "Fold PROC (as per SRFI-1) over SEXP, a canonical sexp."
  (if (canonical-sexp-list? sexp)
      (let ((len (canonical-sexp-length sexp)))
        (let loop ((index  0)
                   (result seed))
          (if (= index len)
              result
              (loop (+ 1 index)
                    ;; XXX: Call 'nth-data' *before* 'nth' to work around
                    ;; <https://dev.gnupg.org/T1594>, which
                    ;; affects 1.6.0 and earlier versions.
                    (proc (or (canonical-sexp-nth-data sexp index)
                              (canonical-sexp-nth sexp index))
                          result)))))
      (error "sexp is not a list" sexp)))

(define (canonical-sexp->sexp sexp)
  "Return a Scheme sexp corresponding to SEXP.  This is particularly useful to
compare sexps (since Libgcrypt does not provide an 'equal?' procedure), or to
use pattern matching."
  (if (canonical-sexp-list? sexp)
      (reverse
       (canonical-sexp-fold (lambda (item result)
                              (cons (if (canonical-sexp? item)
                                        (canonical-sexp->sexp item)
                                        item)
                                    result))
                            '()
                            sexp))

      ;; As of Libgcrypt 1.6.0, there's no function to extract the buffer of a
      ;; non-list sexp (!), so we first enlist SEXP, then get at its buffer.
      (let ((sexp (string->canonical-sexp
                   (string-append "(" (canonical-sexp->string sexp)
                                  ")"))))
        (or (canonical-sexp-nth-data sexp 0)
            (canonical-sexp-nth sexp 0)))))

(define (sexp->canonical-sexp sexp)
  "Return a canonical sexp equivalent to SEXP, a Scheme sexp as returned by
'canonical-sexp->sexp'."
  (define (string-hex-pad str)
    (if (odd? (string-length str))
        (string-append "0" str)
        str))

  ;; XXX: This is inefficient, but the Libgcrypt API doesn't allow us to do
  ;; much better.
  (string->canonical-sexp
    (call-with-output-string
     (lambda (port)
       (define (write item)
         (cond ((list? item)
                (display "(" port)
                (for-each write item)
                (display ")" port))
               ((symbol? item)
                (format port " ~a" item))
               ((bytevector? item)
                (format port " #~a#"
                        (bytevector->base16-string item)))
               ((integer? item)
                (format port " #~a#"
                        (string-hex-pad (number->string item 16))))
               (else
                (error "unsupported sexp item type" item))))

       (write sexp)))))

;;; pk-crypto.scm ends here


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gcrypt random)
  #:use-module (gcrypt internal)
  #:use-module (gcrypt base64)
  #:use-module (rnrs bytevectors)
  #:use-module (system foreign)
  #:use-module (ice-9 match)
  #:export (%gcry-weak-random
            %gcry-strong-random
            %gcry-very-strong-random
            gen-random-bv
            random-token))

(define %gcry-weak-random 0)  ; not used
(define %gcry-strong-random 1)
(define %gcry-very-strong-random 2)

(define %gcry-randomize
  (libgcrypt->procedure void
                      "gcry_randomize"
                      `(* ,size_t ,int)))  ; buffer, length, level

(define* (gen-random-bv #:optional (bv-length 50)
                        (level %gcry-strong-random))
  (let* ((bv (make-bytevector bv-length))
         (bv-ptr (bytevector->pointer bv)))
    (%gcry-randomize bv-ptr bv-length %gcry-strong-random)
    bv))

(define %gcry-create-nonce
  (libgcrypt->procedure void "gcry_create_nonce"
                        `(* ,size_t)))  ; buffer, length

(define* (gen-random-nonce #:optional (bv-length 50))
  (let* ((bv (make-bytevector bv-length))
         (bv-ptr (bytevector->pointer bv)))
    (%gcry-create-nonce bv-ptr bv-length)
    bv))

(define* (random-token #:optional (bv-length 30)
                       (type 'strong))
  "Generate a random token.

Generates a token of bytevector BV-LENGTH, default 30.

The default TYPE is 'strong.  Possible values are:
 - strong: Uses libgcrypt's gcry_randomize procedure with level
   GCRY_STRONG_RANDOM (\"use this level for session keys and similar
   purposes\").
 - very-strong: Also uses libgcrypt's gcry_randomize procedure with level
   GCRY_VERY_STRONG_RANDOM (\"Use this level for long term key material\")
 - nonce: Uses libgcrypt's gcry_xcreate_nonce, whose documentation I'll
   just quote inline:

     Fill BUFFER with LENGTH unpredictable bytes.  This is commonly
     called a nonce and may also be used for initialization vectors and
     padding.  This is an extra function nearly independent of the other
     random function for 3 reasons: It better protects the regular
     random generator's internal state, provides better performance and
     does not drain the precious entropy pool."
  (let ((bv (match type
              ('strong
               (gen-random-bv bv-length %gcry-strong-random))
              ('very-strong
               (gen-random-bv bv-length %gcry-very-strong-random))
              ('nonce
               (gen-random-nonce bv-length)))))
    (base64-encode bv 0 bv-length #f #t base64url-alphabet)))

repo_name: aconchillo/guile

license: mit


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gcrypt utils)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports)
  #:export (dump-port))

(define* (dump-port in out
                    #:key (buffer-size 16384)
                    (progress (lambda (t k) (k))))
  "Read as much data as possible from IN and write it to OUT, using chunks of
BUFFER-SIZE bytes.  Call PROGRESS at the beginning and after each successful
transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes
transferred and the continuation of the transfer as a thunk."
  (define buffer
    (make-bytevector buffer-size))

  (define (loop total bytes)
    (or (eof-object? bytes)
        (let ((total (+ total bytes)))
          (put-bytevector out buffer 0 bytes)
          (progress total
                    (lambda ()
                      (loop total
                            (get-bytevector-n! in buffer 0 buffer-size)))))))

  ;; Make sure PROGRESS is called when we start so that it can measure
  ;; throughput.
  (progress 0
            (lambda ()
              (loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))


code:
\input texinfo
@c -*-texinfo-*-

@c %**start of header
@setfilename guile-gcrypt.info
@documentencoding UTF-8
@settitle Guile-Gcrypt Reference Manual
@c %**end of header

@include version.texi

@copying
Copyright @copyright{} 2018, 2019, 2020 Ludovic Courtès@*

Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.  A
copy of the license is included in the section entitled ``GNU Free
Documentation License''.
@end copying

@dircategory The Algorithmic Language Scheme
@direntry
* Guile-Gcrypt: (guile-gcrypt).   Cryptographic library for Guile.
@end direntry

@titlepage
@title Guile-Gcrypt Reference Manual
@author The Guile-Gcrypt Developers

@page
@vskip 0pt plus 1filll
Edition @value{EDITION} @*
@value{UPDATED} @*

@insertcopying
@end titlepage

@contents

@c *********************************************************************
@node Top
@top Guile-Gcrypt

This manual documents Guile-Gcrypt, a Guile 2.x/3.x interface to the
GNU@tie{}Libgcrypt crytographic library, which is itself used by the
GNU@tie{}Privacy Guard (GPG).  @xref{Top,,, gcrypt, The Libgcrypt
Library}, for more information on Libgcrypt.

Actually this is very much a stub more than an actual manual.  Please
visit @uref{https://notabug.org/cwebber/guile-gcrypt} or email
@email{guile-user@@gnu.org} if you'd like to give a hand!

@menu
* Introduction::                      Getting started.
* Hash Functions::                    SHA1 and its friends.
* Message Authentication Codes::      MACs.
* Public-Key Cryptography::           Signing and encrypting.
* Random Numbers::                    Generating random numbers.
* Miscellany::                        Bonuses!

* GNU Free Documentation License::    The license of this manual.
* Index::                             Index of concepts and procedures.
@end menu

@node Introduction
@chapter Introduction

@cindex modules
Libgcrypt functionality is exposed in a set of Guile modules in the
@code{(gcrypt @dots{})} name space (@pxref{Modules,,, guile, The Guile
Reference Manual}).  Each module provides specific functionality from
Libgcrypt.  For example, the following code imports cryptographic hash
functions:

@lisp
(use-modules (gcrypt hash))
@end lisp

@findex string->canonical-sexp
Procedure names are not a direct mapping of the C function names;
instead, more ``Schemey'' names are chosen for your enjoyment.  For
example, the Libgcrypt's C function called @code{gcry_sexp_new} is
exposed in Scheme as the @code{string->canonical-sexp} procedure in the
@code{(gcrypt pk-crypto)}---more pleasant to the eye, no?

@cindex error handling
@cindex exceptions
When an error occurs, Guile-Gcrypt procedures raise an exception with
the key @code{'gcry-error} (@pxref{Exceptions,,, guile, The Guile
Reference Manual}).  Exceptions have two arguments: the name of the
procedure that raised it, and an @dfn{error number}.  The @code{(gcrypt
common)} modules provides procedures to interpret error numbers:
@code{error-source} and @code{error-string}.  Here's an example showing
how you could report Libgcrypt errors to the user:

@lisp
(catch 'gcry-error
  (lambda ()
    ;; Do something with Guile-Gcrypt...
    )
  (lambda (key proc err)
    (format (current-error-port) "error from '~a': ~a: ~a~%"
            proc (error-source err) (error-string err))))
@end lisp

These two procedures are detailed below.  You can also refer to one of
the @code{error/} constants exported by @code{(gcrypt common)} when
looking for a specific error:

@lisp
(catch 'gcry-error
  (lambda ()
    ;; Do something with Guile-Gcrypt...
    )
  (lambda (key proc err)
    (if (error-code=? err error/bad-signature)
        (format (current-error-port) "Uh oh, bad signature!\n")
        (format (current-error-port) @dots{}))))
@end lisp

@deffn {Scheme Procedure} error-source @var{err}
Return the error source (a string) for @var{err}, an error code as thrown
along with @code{gcry-error}.
@end deffn

@deffn {Scheme Procedure} error-string @var{err}
Return the error description (a string) for @var{err}, an error code as
thrown along with @code{gcry-error}.
@end deffn

@node Hash Functions
@chapter Hash Functions

The @code{(gcrypt hash)} module exports @dfn{cryptographic hash
functions} (@pxref{Hashing,,, gcrypt, The Libgcrypt Library}).
The procedures below all take a @dfn{hash algorithm} as an argument;
these are constructed using the @code{hash-algorithm} macro, as in this
example:

@example
(hash-algorithm sha1)
@end example

Alternately, you can look up a hash algorithm by name using the
@code{lookup-hash-algorithm} procedure:

@example
(lookup-hash-algorithm 'blake2b-512)
@end example

The following macros and procedures allow you to deal with algorithms.

@deffn {Scheme Syntax} hash-algorithm @var{id}
Return the hash algorithm for @var{id}, a lower-case identifier such as
@code{sha1}, @code{whirlpool}, or @code{blake2b-512}.  A syntax error
is raised when @var{id} doesn't match any know algorithm.
@end deffn

@deffn {Scheme Procedure} lookup-hash-algorithm @var{id}
Return the hash algorithm corresponding to @var{id}, a symbol, or
@code{#f} if @var{id} does not denote a known hash algorithm.
@end deffn

@deffn {Scheme Procedure} hash-algorithm-name @var{algorithm}
Return the name, a symbol, of @var{algorithm}, a value as returned by
@code{hash-algorithm}.
@end deffn

@deffn {Scheme Procedure} hash-size @var{algorithm}
Return the size in bytes of hashes produced by @var{algorithm}.
@end deffn

The procedures below offer several ways to compute a hash.

@deffn {Scheme Procedure} bytevector-hash @var{bv} @var{algorithm}
@deffnx {Scheme Procedure} crc32 @var{bv}
@deffnx {Scheme Procedure} sha1 @var{bv}
@deffnx {Scheme Procedure} sha256 @var{bv}
@deffnx {Scheme Procedure} sha512 @var{bv}
@deffnx {Scheme Procedure} sha3-512 @var{bv}
Return the hash @var{algorithm} of @var{bv} as a bytevector.

Shorthand procedures like @code{sha256} are available for all the
algorithms that are valid identifiers for @code{hash-algorithm} though
for brevity only a handful are listed here.
@end deffn

@deffn {Scheme Procedure} open-hash-port @var{algorithm}
@deffnx {Scheme Procedure} open-sha256-port
Return two values: an output port, and a thunk.  When the thunk is
called, it returns the hash (a bytevector) for @var{algorithm} of all
the data written to the output port.
@end deffn

@deffn {Scheme Procedure} port-hash @var{algorithm}
@deffnx {Scheme Procedure} port-sha256
Return the @var{algorithm} hash (a bytevector) of all the data drained
from @var{port}.
@end deffn

@deffn {Scheme Procedure} file-hash @var{algorithm} @var{file}
@deffnx {Scheme Procedure} file-sha256 @var{file}
Return the @var{algorithm} hash (a bytevector) of @var{file}.
@end deffn

@deffn {Scheme Procedure} open-hash-port @var{algorithm} @var{port}
@deffnx {Scheme Procedure} open-sha256-port @var{port}
Return an input port that wraps @var{port} and a thunk to get the hash
of all the data read from @var{port}.  The thunk always returns the same
value.
@end deffn

@deffn {Scheme Procedure} open-hash-input-port @var{algorithm} @var{port}
@deffnx {Scheme Procedure} open-sha256-input-port @var{port}
Return an input port that wraps @var{port} and a thunk to get the hash
of all the data read from @var{port}.  The thunk always returns the same
value.
@end deffn

@node Message Authentication Codes
@chapter Message Authentication Codes

The @code{(gcrypt mac)} module provides procedures to deal with
@dfn{message authentication codes} or @dfn{MACs} (@pxref{Message
Authentication Codes,,, gcrypt, The Libgcrypt Library}).

@quotation Note
Guile-Gcrypt 0.1.0 provided this functionality in the @code{(gcrypt
hmac)} module.  This module is still provided for backward
compatibility, with the same interface as before, but it is deprecated
and will be removed in future versions.
@end quotation

Similar to how hash functions are handled (@pxref{Hash Functions}), the
@code{mac-algorithm} macro can be used to construct a MAC algorithm:

@example
(mac-algorithm hmac-sha3-512)
@end example

The following macros and procedures allow you to deal with algorithms.

@deffn {Scheme Syntax} mac-algorithm @var{id}
Return the MAC algorithm for @var{id}, a lower-case identifier such as
@code{sha256}.  A syntax error is raised when @var{id} doesn't match any
know algorithm.
@end deffn

@deffn {Scheme Procedure} lookup-mac-algorithm @var{id}
Return the MAC algorithm corresponding to @var{id}, a symbol, or
@code{#f} if @var{id} does not denote a known MAC algorithm.
@end deffn

@deffn {Scheme Procedure} mac-algorithm-name @var{algorithm}
Return the name, a symbol, of @var{algorithm}, a value as returned by
@code{mac-algorithm}.
@end deffn

@deffn {Scheme Procedure} mac-size @var{algorithm}
Return the size in bytes of MACs produced by @var{algorithm}.
@end deffn

@c TODO
@quotation Warning
This section is incomplete.
@end quotation

@node Public-Key Cryptography
@chapter Public-Key Cryptography

@cindex public-key cryptography
@cindex canonical S-expressions
Tools for @dfn{public-key cryptography} (@pxref{Public Key
cryptography,,, gcrypt, The Libgcrypt Library}) are provided by the
@code{(gcrypt pk-crypto)} module.

This module includes code to deal with @dfn{canonical S-expressions} (or
``sexps'') @uref{http://people.csail.mit.edu/rivest/Sexp.txt, as defined
by Rivest et al.}  They are used to specify public-key cryptography
parameters (@pxref{Used S-expressions,,, gcrypt, The Libgcrypt
Library}).  Naturally, there are procedures to convert a Guile sexp to a
Libgcrypt canonical sexp object and @i{vice versa}:

@deffn {Scheme Procedure} canonical-sexp->sexp @var{sexp}
Return a Scheme sexp corresponding to @var{sexp}.  This is particularly useful to
compare sexps (since Libgcrypt does not provide an @code{equal?} procedure), or to
use pattern matching.
@end deffn

@deffn {Scheme Procedure} sexp->canonical-sexp @var{sexp}
Return a canonical sexp equivalent to @var{sexp}, a Scheme sexp as returned by
@code{canonical-sexp->sexp}.
@end deffn

@deffn {Scheme Procedure} string->canonical-sexp @var{str}
Parse @var{str} and return the corresponding gcrypt s-expression.
@end deffn

@deffn {Scheme Procedure} canonical-sexp->string @var{sexp}
Return a textual representation of @var{sexp}.
@end deffn

@cindex key pair generation
@cindex generating key pairs
For example, here is how you would generate an Ed25519 key pair and
display its public key as a canonical sexp:

@findex generate-key
@findex find-sexp-token
@lisp
(use-modules (gcrypt pk-crypto))

(let* ((parameters (sexp->canonical-sexp
                     '(genkey
                        (ecdsa (curve Ed25519) (flags rfc6979)))))
       (pair       (generate-key parameters))
       (public     (find-sexp-token pair 'public-key)))
  (display (canonical-sexp->string public)))

@print{}
(public-key
 (ecc
  (curve Ed25519)
  (q #141D9C42@dots{}CE853B#)
  )
 )
@end lisp

Notice that we did @emph{not} pass @code{pair} to
@code{canonical-sexp->sexp}: that would have worked, but the private key
would have been copied to memory managed by the garbage collector, which
is a security risk---Libgcrypt might have stored the private key in
so-called ``secure memory'' protected from swap, whereas Guile does no
such thing for its objects (@pxref{Initializing the library, secure
memory,, gcrypt, The Libgcrypt Library}).  Thus the above example uses
@code{find-sexp-token}, which accesses the canonical sexp directly, in
search for the @code{public-key} symbol.

@xref{Used S-expressions,,, gcrypt, The Libgcrypt Library}, for more
information on the canonical sexps consumed and produced by public-key
cryptography functions.

@node Random Numbers
@chapter Random Numbers
The @code{(gcrypt random)} module provides tools to generate random
number of different quality levels (@pxref{Random Numbers,,, gcrypt, The
Libgcrypt Library}).

@node Miscellany
@chapter Miscellany

As a bonus, Guile-Gcrypt provides two useful modules:

@itemize
@item @code{(gcrypt base16)} provides procedures to encode and decode
hexadecimal strings;

@item @code{(gcrypt base64)} provides procedures to encode and decode
base64 strings as defined in @uref{https://tools.ietf.org/html/rfc4648,
RFC 4648}.
@end itemize

@c *********************************************************************
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@cindex license, GNU Free Documentation License
@include fdl-1.3.texi

@c *********************************************************************
@node Index
@unnumbered Index
@printindex cp
@syncodeindex tp fn
@syncodeindex vr fn
@printindex fn

@bye

@c Local Variables:
@c ispell-local-dictionary: "american";
@c End:


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (guix packages)
             (guix build-system gnu)
             (guix download)
             (guix git-download)
             (guix gexp)
             ((guix build utils) #:select (with-directory-excursion))
             (gnu packages)
             (gnu packages autotools)
             (gnu packages base)
             (gnu packages guile)
             (gnu packages pkg-config)
             (gnu packages texinfo)
             (gnu packages gnupg)
             (guix licenses))

(define %source-dir (dirname (current-filename)))

(define guile-gcrypt
  (package
    (name "guile-gcrypt")
    (version "git")
    (source (local-file %source-dir
                        #:recursive? #t
                        #:select? (git-predicate %source-dir)))
    (build-system gnu-build-system)
    (arguments
     '(#:phases
       (modify-phases %standard-phases
         (add-after 'unpack 'bootstrap
           (lambda _ (zero? (system* "sh" "bootstrap.sh")))))))
    (native-inputs
     `(("pkg-config" ,pkg-config)
       ("autoconf" ,autoconf)
       ("automake" ,automake)
       ("texinfo" ,texinfo)))
    (inputs
     `(("guile" ,guile-2.2)
       ("libgcrypt" ,libgcrypt)))
    (home-page "https://notabug.org/cwebber/guile-gcrypt")
    (synopsis "Crypto library for Guile using libgcrypt")
    (description "guile-gcrypt uses Guile's foreign function interface to wrap
libgcrypt to provide a variety of encryption tooling.")
    (license gpl3+)))

guile-gcrypt


code:
dnl GNU Guix --- Functional package management for GNU
dnl Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
dnl Copyright © 2014 Mark H Weaver <mhw@netris.org>
dnl
dnl This file is part of GNU Guix.
dnl
dnl GNU Guix is free software; you can redistribute it and/or modify it
dnl under the terms of the GNU General Public License as published by
dnl the Free Software Foundation; either version 3 of the License, or (at
dnl your option) any later version.
dnl
dnl GNU Guix is distributed in the hope that it will be useful, but
dnl WITHOUT ANY WARRANTY; without even the implied warranty of
dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
dnl GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public License
dnl along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

dnl GUIX_ASSERT_LIBGCRYPT_USABLE
dnl
dnl Assert that GNU libgcrypt is usable from Guile.
AC_DEFUN([GUIX_ASSERT_LIBGCRYPT_USABLE],
  [AC_CACHE_CHECK([whether $LIBGCRYPT can be dynamically loaded],
    [guix_cv_libgcrypt_usable_p],
    [GUILE_CHECK([retval],
      [(dynamic-func \"gcry_md_hash_buffer\" (dynamic-link \"$LIBGCRYPT\"))])
     if test "$retval" = 0; then
       guix_cv_libgcrypt_usable_p="yes"
     else
       guix_cv_libgcrypt_usable_p="no"
     fi])

   if test "x$guix_cv_libgcrypt_usable_p" != "xyes"; then
     AC_MSG_ERROR([GNU libgcrypt does not appear to be usable; see `--with-libgcrypt-prefix' and `README'.])
   fi])

dnl GUIX_LIBGCRYPT_LIBDIR VAR
dnl
dnl Attempt to determine libgcrypt's LIBDIR; store the result in VAR.
AC_DEFUN([GUIX_LIBGCRYPT_LIBDIR], [
  AC_PATH_PROG([LIBGCRYPT_CONFIG], [libgcrypt-config])
  AC_CACHE_CHECK([libgcrypt's library directory],
    [guix_cv_libgcrypt_libdir],
    [if test "x$LIBGCRYPT_CONFIG" != "x"; then
       guix_cv_libgcrypt_libdir=`$LIBGCRYPT_CONFIG --libs | grep -e -L | sed -e "s/.*-L\([[^ ]]\+\)[[[:blank:]]]\+-lgcrypt.*/\1/g"`
     else
       guix_cv_libgcrypt_libdir=""
     fi])
  $1="$guix_cv_libgcrypt_libdir"
])


code:
#!/bin/sh

# srt2vtt --- SRT to WebVTT converter
# Copyright © 2015 David Thompson <davet@gnu.org>
# Copyright © 2015, 2016 Christopher Allan Webber <cwebber@dustycloud.org>
#
# srt2vtt is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# srt2vtt is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with srt2vtt.  If not, see <http://www.gnu.org/licenses/>.

abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"

# Override 'GUILE_LOAD_COMPILED_PATH' altogether to avoid loading
# gcrypt .go files that could be there and more recent, for instance
# because the user ran 'make install' recently.
GUILE_LOAD_COMPILED_PATH="$abs_top_builddir"
GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir"
export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH

PATH="$abs_top_builddir/scripts:$PATH"
export PATH

GUILE_GCRYPT_DATADIR="$abs_top_builddir/data"
export GUILE_GCRYPT_DATADIR

exec "$@"


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2012, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-base16)
  #:use-module (gcrypt base16)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors))

(test-begin "base16")

(test-assert "bytevector->base16-string->bytevector"
  (every (lambda (bv)
           (equal? (base16-string->bytevector
                    (bytevector->base16-string bv))
                   bv))
         (map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))

(test-end "base16")


code:
;;; guile-gcrypt --- crypto tooling for guile
;;;
;;; Code taken from:
;;;
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-base64)
  #:use-module (gcrypt base64)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-64))

(define (string->base64 str)
  (base64-encode (string->utf8 str)))

(define (base64->string base64)
  (utf8->string (base64-decode base64)))

(define (string->base64-padding str padding)
  (let ((bv (string->utf8 str)))
    (base64-encode bv 0 (bytevector-length bv) #f (not padding))))

(define (base64->string-padding base64 padding)
  (utf8->string (base64-decode base64 base64url-alphabet #f #f padding)))

;;; Test vectors from <https://tools.ietf.org/rfc/rfc4648.txt>.

(test-begin "base64")

;; Encoding

(test-equal "empty string"
  (string->base64 "")
  "")

(test-equal "f"
  (string->base64 "f")
  "Zg==")

(test-equal "fo"
  (string->base64 "fo")
  "Zm8=")

(test-equal "foo"
  (string->base64 "foo")
  "Zm9v")

(test-equal "foob"
  (string->base64 "foob")
  "Zm9vYg==")

(test-equal "fooba"
  (string->base64 "fooba")
  "Zm9vYmE=")

(test-equal "foobar"
  (string->base64 "foobar")
  "Zm9vYmFy")

(test-equal "foob (no padding)"
  (string->base64-padding "foob" #f)
  "Zm9vYg")

(test-equal "foob (padding)"
  (string->base64-padding "foob" #t)
  "Zm9vYg==")

;; Decoding

(test-equal "empty string"
  (base64->string "")
  "")

(test-equal "f"
  (base64->string "Zg==")
  "f")

(test-equal "fo"
  (base64->string "Zm8=")
  "fo")

(test-equal "foo"
  (base64->string "Zm9v")
  "foo")

(test-equal "foob"
  (base64->string "Zm9vYg==")
  "foob")

(test-equal "fooba"
  (base64->string "Zm9vYmE=")
  "fooba")

(test-equal "foobar"
  (base64->string "Zm9vYmFy")
  "foobar")

(test-equal "foob (no padding)"
  (base64->string-padding "Zm9vYg" #f)
  "foob")

(test-equal "foob (padding)"
  (base64->string-padding "Zm9vYg==" #t)
  "foob")

(test-end "base64")


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2013, 2014, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-hash)
  #:use-module (gcrypt hash)
  #:use-module (gcrypt base16)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports))

;; Test the (guix hash) module.

(define %empty-sha256
  ;; SHA256 hash of the empty string.
  (base16-string->bytevector
   "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"))

(define %hello-sha256
  ;; SHA256 hash of "hello world"
  (base16-string->bytevector
   "b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9"))

(define %hello-sha512
  (base16-string->bytevector
   "309ecc489c12d6eb4cc40f50c902f2b4d0ed77ee511a7c7a9bcd3ca86d4cd86f989dd35bc5ff499670da34255b45b0cfd830e81f605dcf7dc5542e93ae9cd76f"))

(define (supports-unbuffered-cbip?)
  "Return #t if unbuffered custom binary input ports (CBIPs) are supported.
In Guile <= 2.0.9, CBIPs were always fully buffered, so the
'open-hash-input-port' does not work there."
  (false-if-exception
   (setvbuf (make-custom-binary-input-port "foo" pk #f #f #f)
            (cond-expand ((and guile-2 (not guile-2.2)) _IONBF)
                         (else 'none)))))

(test-begin "hash")

(test-equal "lookup-hash-algorithm"
  (hash-algorithm blake2b-512)
  (lookup-hash-algorithm 'blake2b-512))

(test-eq "hash-algorithm-name"
  'sha3-512
  (hash-algorithm-name (hash-algorithm sha3-512)))

(test-equal "hash-size"
  (list 20 32 64)
  (map hash-size
       (list (hash-algorithm sha1)
             (hash-algorithm sha256)
             (hash-algorithm sha512))))

(test-equal "sha1, empty"
  (base16-string->bytevector "da39a3ee5e6b4b0d3255bfef95601890afd80709")
  (sha1 #vu8()))

(test-equal "sha1, hello"
  (base16-string->bytevector "2aae6c35c94fcfb415dbe95f408b9ce91ee846ed")
  (sha1 (string->utf8 "hello world")))

(test-equal "sha256, empty"
  %empty-sha256
  (sha256 #vu8()))

(test-equal "sha256, hello"
  %hello-sha256
  (sha256 (string->utf8 "hello world")))

(test-equal "sha512, empty"
  "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"
  (bytevector->base16-string (sha512 #vu8())))

(test-equal "sha512, hello"
  %hello-sha512
  (bytevector-hash (string->utf8 "hello world")
                   (hash-algorithm sha512)))

(test-equal "open-sha256-port, empty"
  %empty-sha256
  (let-values (((port get)
                (open-sha256-port)))
    (close-port port)
    (get)))

(test-equal "open-sha256-port, hello"
  (list %hello-sha256 (string-length "hello world"))
  (let-values (((port get)
                (open-sha256-port)))
    (put-bytevector port (string->utf8 "hello world"))
    (force-output port)
    (list (get) (port-position port))))

(test-equal "open-hash-port, sha512, hello"
  (list %hello-sha512 (string-length "hello world"))
  (let-values (((port get)
                (open-hash-port (hash-algorithm sha512))))
    (put-bytevector port (string->utf8 "hello world"))
    (force-output port)
    (list (get) (port-position port))))

(test-assert "port-sha256"
  (let* ((file     (search-path %load-path "ice-9/psyntax.scm"))
         (size     (stat:size (stat file)))
         (contents (call-with-input-file file get-bytevector-all)))
    (equal? (sha256 contents)
            (call-with-input-file file port-sha256))))

(test-skip (if (supports-unbuffered-cbip?) 0 4))

(test-equal "open-sha256-input-port, empty"
  `("" ,%empty-sha256)
  (let-values (((port get)
                (open-sha256-input-port (open-string-input-port ""))))
    (let ((str (get-string-all port)))
      (list str (get)))))

(test-equal "open-sha256-input-port, hello"
  `("hello world" ,%hello-sha256)
  (let-values (((port get)
                (open-sha256-input-port
                 (open-bytevector-input-port
                  (string->utf8 "hello world")))))
    (let ((str (get-string-all port)))
      (list str (get)))))

(test-equal "open-hash-input-port, sha512, hello"
  `("hello world" ,%hello-sha512)
  (let-values (((port get)
                (open-hash-input-port
                 (hash-algorithm sha512)
                 (open-bytevector-input-port
                  (string->utf8 "hello world")))))
    (let ((str (get-string-all port)))
      (list str (get)))))

(test-equal "open-sha256-input-port, hello, one two"
  (list (string->utf8 "hel") (string->utf8 "lo")
        (base16-string->bytevector                ; echo -n hello | sha256sum
         "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824")
        " world")
  (let-values (((port get)
                (open-sha256-input-port
                 (open-bytevector-input-port (string->utf8 "hello world")))))
    (let* ((one   (get-bytevector-n port 3))
           (two   (get-bytevector-n port 2))
           (hash  (get))
           (three (get-string-all port)))
      (list one two hash three))))

(test-equal "open-sha256-input-port, hello, read from wrapped port"
  (list (string->utf8 "hello")
        (base16-string->bytevector                ; echo -n hello | sha256sum
         "2cf24dba5fb0a30e26e83b2ac5b9e29e1b161e5c1fa7425e73043362938b9824")
        " world")
  (let*-values (((wrapped)
                 (open-bytevector-input-port (string->utf8 "hello world")))
                ((port get)
                 (open-sha256-input-port wrapped)))
    (let* ((hello (get-bytevector-n port 5))
           (hash  (get))

           ;; Now read from WRAPPED to make sure its current position is
           ;; correct.
           (world (get-string-all wrapped)))
      (list hello hash world))))

(test-end)


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-mac)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-64)
  #:use-module (gcrypt hmac))                     ;the deprecated module

(test-begin "hmac")

(define test-key (gen-signing-key))

(let ((sig (sign-data test-key "monkey party"
                      #:algorithm 'sha256)))
  ;; Should be a bytevector
  (test-assert (bytevector? sig))

  ;; Correct sig succeeds
  (test-assert (verify-sig test-key "monkey party" sig
                           #:algorithm 'sha256)))

(let ((sig (sign-data test-key "monkey party")))
  ;; Should be a bytevector
  (test-assert (bytevector? sig))

  ;; Correct sig succeeds
  (test-assert (verify-sig test-key "monkey party" sig)))

(test-end "hmac")


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-mac)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-64)
  #:use-module (gcrypt mac))

(test-begin "mac")

(test-equal "lookup-mac-algorithm"
  (mac-algorithm hmac-sha3-256)
  (lookup-mac-algorithm 'hmac-sha3-256))

(test-eq "mac-algorithm-name"
  'hmac-sha3-512
  (mac-algorithm-name (mac-algorithm hmac-sha3-512)))

(test-equal "mac-size"
  (list 32 28 64 64)
  (map mac-size
       (list (mac-algorithm hmac-sha256)
             (mac-algorithm hmac-sha224)
             (mac-algorithm hmac-sha512)
             (mac-algorithm hmac-sha3-512))))

(define test-key (generate-signing-key))

(let ((sig (sign-data test-key "monkey party"
                      #:algorithm (mac-algorithm hmac-sha256))))
  ;; Should be a bytevector
  (test-assert (bytevector? sig))
  ;; Correct sig succeeds
  (test-assert (valid-signature? test-key "monkey party" sig
                                 #:algorithm (mac-algorithm hmac-sha256)))
  ;; Incorrect data fails
  (test-assert (not (valid-signature? test-key "something else" sig
                                      #:algorithm
                                      (mac-algorithm hmac-sha256))))
  ;; Fake signature fails
  (test-assert (not (valid-signature? test-key "monkey party"
                                      (string->utf8 "fake sig")
                                      #:algorithm
                                      (mac-algorithm hmac-sha256))))
  ;; Wrong algorithm fails
  (test-assert (not (valid-signature? test-key "monkey party" sig
                                      #:algorithm
                                      (mac-algorithm hmac-sha512))))
  ;; Should equal a re-run of itself
  (test-equal sig (sign-data test-key "monkey party"
                             #:algorithm (mac-algorithm hmac-sha256)))
  ;; Shouldn't equal something different
  (test-assert (not (equal? sig (sign-data test-key "cookie party"
                                           #:algorithm
                                           (mac-algorithm hmac-sha256))))))

;; Now with a CMAC.
(let* ((key (generate-signing-key 16))
       (sig (sign-data key "monkey party"
                       #:algorithm (mac-algorithm cmac-aes))))
  ;; Should be a bytevector
  (test-assert (bytevector? sig))
  ;; Correct sig succeeds
  (test-assert (valid-signature? key "monkey party" sig
                                 #:algorithm (mac-algorithm cmac-aes)))
  ;; Fake signature fails
  (test-assert (not (valid-signature? key "monkey party"
                                      (string->utf8 "fake sig")
                                      #:algorithm (mac-algorithm cmac-aes)))))

;; Now with base64 encoding
(let ((sig (sign-data-base64 test-key "monkey party")))
  ;; Should be a string
  (test-assert (string? sig))
  ;; Correct sig succeeds
  (test-assert (valid-base64-signature? test-key "monkey party" sig))
  ;; Incorrect data fails
  (test-assert (not (valid-base64-signature? test-key "something else" sig)))
  ;; Fake signature fails
  (test-assert (not (valid-base64-signature? test-key "monkey party"
                                             "f41c3516")))
  ;; Should equal a re-run of itself
  (test-equal sig (sign-data-base64 test-key "monkey party"))
  ;; Shouldn't equal something different
  (test-assert (not (equal? sig (sign-data-base64 test-key "cookie party")))))

(test-end "mac")


code:
;;; guile-gcrypt --- crypto tooling for guile
;;; Copyright © 2013, 2014, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of guile-gcrypt.
;;;
;;; guile-gcrypt is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; guile-gcrypt is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with guile-gcrypt.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-pk-crypto)
  #:use-module (gcrypt pk-crypto)
  #:use-module (gcrypt utils)
  #:use-module (gcrypt base16)
  #:use-module (gcrypt hash)
  #:use-module (gcrypt common)                    ;error codes
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match))

;; Test the (guix pk-crypto) module.

(define %key-pair
  ;; RSA key pair that was generated with:
  ;;   (generate-key (string->canonical-sexp "(genkey (rsa (nbits 4:1024)))"))
  ;; which takes a bit of time.
  "(key-data
    (public-key
     (rsa
      (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
      (e #010001#)))
    (private-key
     (rsa
      (n #00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45#)
      (e #010001#)
      (d #58CAD84653D0046A8EC3F9AA82D9C829B145422109FC3F12DA01A694B92FA296E70D366FB166454D30E632CEE3A033B4C41781BA10325F69FCDC0250CA19C8EEB352FA085992494098DB133E682ED38A931701F0DED1A1E508F4341A4FB446A04F019427C7CB3C44F251EEA9D386100DA80F125E0FD5CE1B0DFEC6D21516EACD#)
      (p #00D47F185147EC39393CCDA4E7323FFC20FC8B8073E2A54DD63BA392A66975E4204CA48572496A9DFD7522436B852C07472A5AB25B7706F7C14E6F33FBC420FF3B#)
      (q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#)
      (u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))))")

(define %ecc-key-pair
  ;; Ed25519 key pair generated with:
  ;;   (generate-key (string->canonical-sexp "(genkey (ecdsa (curve Ed25519) (flags rfc6979 transient)))"))
  "(key-data
      (public-key
        (ecc
          (curve Ed25519)
          (q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#)))
      (private-key
        (ecc
          (curve Ed25519)
          (q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#)
          (d #6EFB32D0B4EC6B3237B523539F1979379B82726AAA605EB2FBA6775B2B777B78#))))")

(test-begin "pk-crypto")

(test-assert "version"
  (gcrypt-version))

(let ((sexps '("(foo bar)"

               ;; In Libgcrypt 1.5.3 the following integer is rendered as
               ;; binary, whereas in 1.6.0 it's rendered as is (hexadecimal.)
               ;;"#C0FFEE#"

               "(genkey \n (rsa \n  (nbits \"1024\")\n  )\n )")))
  (test-equal "string->canonical-sexp->string"
    sexps
    (let ((sexps (map string->canonical-sexp sexps)))
      (and (every canonical-sexp? sexps)
           (map (compose string-trim-both canonical-sexp->string) sexps)))))

(gc)                                              ; stress test!

(let ((sexps `(("(foo bar)" foo -> "(foo bar)")
               ("(foo (bar (baz 3:123)))" baz -> "(baz \"123\")")
               ("(foo (bar 3:123))" baz -> #f))))
  (test-equal "find-sexp-token"
    (map (match-lambda
          ((_ _ '-> expected)
           expected))
         sexps)
    (map (match-lambda
          ((input token '-> _)
           (let ((sexp (find-sexp-token (string->canonical-sexp input) token)))
             (and sexp
                  (string-trim-both (canonical-sexp->string sexp))))))
         sexps)))

(gc)

(test-equal "canonical-sexp-length"
  '(0 1 2 4 0 0)
  (map (compose canonical-sexp-length string->canonical-sexp)
       '("()" "(a)" "(a b)" "(a #616263# b #C001#)" "a" "#123456#")))

(test-equal "canonical-sexp-list?"
  '(#t #f #t #f)
  (map (compose canonical-sexp-list? string->canonical-sexp)
       '("()" "\"abc\"" "(a b c)" "#123456#")))

(gc)

(test-equal "canonical-sexp-car + cdr"
  '("(b \n (c xyz)\n )")
  (let ((lst (string->canonical-sexp "(a (b (c xyz)))")))
    (map (lambda (sexp)
           (and sexp (string-trim-both (canonical-sexp->string sexp))))
         ;; Note: 'car' returns #f when the first element is an atom.
         (list (canonical-sexp-car (canonical-sexp-cdr lst))))))

(gc)

(test-equal "canonical-sexp-nth"
  '("(b pqr)" "(c \"456\")" "(d xyz)" #f #f)

  (let ((lst (string->canonical-sexp "(a (b 3:pqr) (c 3:456) (d 3:xyz))")))
    ;; XXX: In Libgcrypt 1.5.3, (canonical-sexp-nth lst 0) returns LST, whereas in
    ;; 1.6.0 it returns #f.
    (map (lambda (sexp)
           (and sexp (string-trim-both (canonical-sexp->string sexp))))
         (unfold (cut > <> 5)
                 (cut canonical-sexp-nth lst <>)
                 1+
                 1))))

(gc)

(test-equal "canonical-sexp-nth-data"
  `(Name Otto Meier #f ,(base16-string->bytevector "123456") #f)
  (let ((lst (string->canonical-sexp
              "(Name Otto Meier (address Burgplatz) #123456#)")))
    (unfold (cut > <> 5)
            (cut canonical-sexp-nth-data lst <>)
            1+
            0)))

(let ((bv (base16-string->bytevector
           "5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c")))
  (test-equal "hash corrupt due to restrictive locale encoding"
    bv

    ;; In Guix up to 0.6 included this test would fail because at some point
    ;; the hash value would be cropped to ASCII.  In practice 'guix
    ;; authenticate' would produce invalid signatures that would fail
    ;; signature verification.  See <http://bugs.gnu.org/17312>.
    (let ((locale (setlocale LC_ALL)))
     (dynamic-wind
       (lambda ()
         (setlocale LC_ALL "C"))
       (lambda ()
         (hash-data->bytevector
          (string->canonical-sexp
           (canonical-sexp->string
            (bytevector->hash-data bv "sha256")))))
       (lambda ()
         (setlocale LC_ALL locale))))))

(gc)

;; XXX: The test below is typically too long as it needs to gather enough entropy.

;; (test-assert "generate-key"
;;   (let ((key (generate-key (string->canonical-sexp
;;                             "(genkey (rsa (nbits 3:128)))"))))
;;     (and (canonical-sexp? key)
;;          (find-sexp-token key 'key-data)
;;          (find-sexp-token key 'public-key)
;;          (find-sexp-token key 'private-key))))

(test-assert "bytevector->hash-data->bytevector"
  (let* ((bv   (sha256 (string->utf8 "Hello, world.")))
         (data (bytevector->hash-data bv "sha256")))
    (and (canonical-sexp? data)
         (let-values (((value algo) (hash-data->bytevector data)))
           (and (string=? algo "sha256")
                (bytevector=? value bv))))))

(test-equal "key-type"
  '(rsa ecc)
  (map (compose key-type
                (cut find-sexp-token <> 'public-key)
                string->canonical-sexp)
       (list %key-pair %ecc-key-pair)))

(test-equal "sign + verify, bogus signature"
  `(verify . ,(gcrypt-error error/invalid-object))
  (catch 'gcry-error
    (lambda ()
      (let* ((pair   (string->canonical-sexp %key-pair))
             (secret (find-sexp-token pair 'private-key))
             (public (find-sexp-token pair 'public-key))
             (data   (bytevector->hash-data
                      (sha256 (string->utf8 "Hello, world."))
                      #:key-type (key-type public)))
             (bogus  (string->canonical-sexp "(bogus sig)")))
        (verify bogus data public)))
    (lambda (key proc error)
      (cons proc error))))

(test-assert "sign + verify"
  (let* ((pair   (string->canonical-sexp %key-pair))
         (secret (find-sexp-token pair 'private-key))
         (public (find-sexp-token pair 'public-key))
         (data   (bytevector->hash-data
                  (sha256 (string->utf8 "Hello, world."))
                  #:key-type (key-type public)))
         (sig    (sign data secret)))
    (and (verify sig data public)
         (not (verify sig
                      (bytevector->hash-data
                       (sha256 (string->utf8 "Hi!"))
                       #:key-type (key-type public))
                      public)))))

(test-assert "sign + verify, Ed25519"
  (let* ((pair   (string->canonical-sexp %ecc-key-pair))
         (secret (find-sexp-token pair 'private-key))
         (public (find-sexp-token pair 'public-key))
         (data   (bytevector->hash-data
                  (sha256 (string->utf8 "Hello, world."))))
         (sig    (sign data secret)))
    (and (verify sig data public)
         (not (verify sig
                      (bytevector->hash-data
                       (sha256 (string->utf8 "Hi!")))
                      public)))))

(gc)

(test-equal "canonical-sexp->sexp"
  `((data
     (flags pkcs1)
     (hash sha256
           ,(base16-string->bytevector
             "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb")))

    (public-key
     (rsa
      (n ,(base16-string->bytevector
           (string-downcase
            "00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45")))
      (e ,(base16-string->bytevector
           "010001")))))

  (list (canonical-sexp->sexp
         (string->canonical-sexp
          "(data
             (flags pkcs1)
             (hash \"sha256\"
                   #2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb#))"))

        (canonical-sexp->sexp
         (find-sexp-token (string->canonical-sexp %key-pair)
                          'public-key))))

(let ((lst
       `((data
          (flags pkcs1)
          (hash sha256
                ,(base16-string->bytevector
                  "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb")))

         (public-key
          (rsa
           (n ,(base16-string->bytevector
                (string-downcase
                 "00C1F764069F54FFE93A126B02328903E984E4AE3AF6DF402B5B6B3907911B88C385F1BA76A002EC9DEA109A5228EF0E62EE31A06D1A5861CAB474F6C857AC66EB65A1905F25BBA1869579E73A3B7FED13AF5A1667326F88CDFC2FF24B03C14FD1384AA7E73CA89572880B606E3A974E15347963FC7B6378574936A47580DBCB45")))
           (e ,(base16-string->bytevector
                "010001"))))

         ,(base16-string->bytevector
           "2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"))))
  (test-equal "sexp->canonical-sexp->sexp"
    lst
    (map (compose canonical-sexp->sexp sexp->canonical-sexp)
         lst)))

(let ((sexp `(signature
              (public-key
               (rsa
                (n ,(make-bytevector 1024 1))
                (e ,(base16-string->bytevector "010001")))))))
  (test-equal "https://dev.gnupg.org/T1594"
    ;; The gcrypt bug above was primarily affecting our uses in
    ;; 'canonical-sexp->sexp', typically when applied to a signature sexp (in
    ;; 'guix authenticate -verify') with a "big" RSA key, such as 4096 bits.
    sexp
    (canonical-sexp->sexp (sexp->canonical-sexp sexp))))

;; In Guile-Gcrypt <= 0.2.1, 'canonical-sexp->sexp' did not support integers.
(test-equal "sexp->canonical-sexp, big integers"
  '(a (b #vu8(#x01 #x23 #x45 #x67 #x89))
      (c #vu8(#x98 #x76 #x54 #x32 #x10)))
  (canonical-sexp->sexp
   (sexp->canonical-sexp
    '(a (b #x123456789) (c #x9876543210)))))

(test-end)


code:
uds.pro.user
android/bin
android/libs
android/gen

repo_name: snapshot/uds

path: .gitignore


code:
[submodule "libqcalparser"]
	path = libqcalparser
	url = https://github.com/shadeslayer/libqcalparser.git

path: .gitmodules


code:
<?xml version='1.0' encoding='utf-8'?>
<manifest package="com.ubuntu.summit" android:versionCode="1" xmlns:android="http://schemas.android.com/apk/res/android" android:versionName="12.04.0">
    <application android:name="eu.licentia.necessitas.industrius.QtApplication" android:icon="@drawable/icon" android:label="@string/app_name">
        <activity android:name="eu.licentia.necessitas.industrius.QtActivity" android:configChanges="orientation|locale|fontScale|keyboard|keyboardHidden" android:label="@string/app_name">
            <intent-filter>
                <action android:name="android.intent.action.MAIN"/>
                <category android:name="android.intent.category.LAUNCHER"/>
            </intent-filter>
            <meta-data android:name="android.app.qt_libs_resource_id" android:resource="@array/qt_libs"/>
            <meta-data android:name="android.app.bundled_libs_resource_id" android:resource="@array/bundled_libs"/>
            <meta-data android:name="android.app.lib_name" android:value="uds"/>
        </activity>
    </application>
    <supports-screens android:largeScreens="true" android:normalScreens="true" android:anyDensity="true" android:smallScreens="true"/>
    <uses-permission android:name="android.permission.INTERNET"/>
    <uses-permission android:name="android.permission.WRITE_EXTERNAL_STORAGE"/>
</manifest>


code:
<?xml version="1.0" encoding="UTF-8"?>
<project name="Ubuntu Developer Summit" default="help">

<!-- The local.properties file is created and updated by the 'android'
     tool.
     It contains the path to the SDK. It should *NOT* be checked into
     Version Control Systems. -->
    <property file="local.properties" />

    <!-- The build.properties file can be created by you and is never touched
         by the 'android' tool. This is the place to change some of the
         default property values used by the Ant rules.
         Here are some properties you may want to change/update:

         source.dir
             The name of the source directory. Default is 'src'.
         out.dir
             The name of the output directory. Default is 'bin'.

         Properties related to the SDK location or the project target should
         be updated using the 'android' tool with the 'update' action.

         This file is an integral part of the build system for your
         application and should be checked into Version Control Systems.

         -->
    <property file="build.properties" />

    <!-- The default.properties file is created and updated by the 'android'
         tool, as well as ADT.
         This file is an integral part of the build system for your
         application and should be checked into Version Control Systems. -->
    <property file="default.properties" />

    <!-- Required pre-setup import -->
    <import file="${sdk.dir}/tools/ant/pre_setup.xml" />

<!-- extension targets. Uncomment the ones where you want to do custom work
     in between standard targets -->
<!--
    <target name="-pre-build">
    </target>
    <target name="-pre-compile">
    </target>

    [This is typically used for code obfuscation.
     Compiled code location: ${out.classes.absolute.dir}
     If this is not done in place, override ${out.dex.input.absolute.dir}]
    <target name="-post-compile">
    </target>
-->

    <!-- Execute the Android Setup task that will setup some properties
         specific to the target, and import the build rules files.

         The rules file is imported from
            <SDK>/tools/ant/
         Depending on the project type it can be either:
         - main_rules.xml
         - lib_rules.xml
         - test_rules.xml

         To customize existing targets, there are two options:
         - Customize only one target:
             - copy/paste the target into this file, *before* the
               <setup> task.
             - customize it to your needs.
         - Customize the whole script.
             - copy/paste the content of the rules files (minus the top node)
               into this file, *after* the <setup> task
             - disable the import of the rules by changing the setup task
               below to <setup import="false" />.
             - customize to your needs.
    -->
    <setup />

</project>


code:
# This file is automatically generated by Android Tools.
# Do not modify this file -- YOUR CHANGES WILL BE ERASED!
#
# This file must be checked in Version Control Systems.
#
# To customize properties used by the Ant build system use,
# "build.properties", and override values to adapt the script to your
# project structure.

# Project target.
target=android-4


code:
# This file is automatically generated by Android Tools.
# Do not modify this file -- YOUR CHANGES WILL BE ERASED!
#
# This file must *NOT* be checked in Version Control Systems,
# as it contains information specific to your local configuration.

# location of the SDK. This is only used by Ant
# For customization when using a Version Control System, please read the
# header note.
sdk.dir=/home/me/Programs/necessitas/android-sdk-linux_x86


code:
-optimizationpasses 5
-dontusemixedcaseclassnames
-dontskipnonpubliclibraryclasses
-dontpreverify
-verbose
-optimizations !code/simplification/arithmetic,!field/*,!class/merging/*

-keep public class * extends android.app.Activity
-keep public class * extends android.app.Application
-keep public class * extends android.app.Service
-keep public class * extends android.content.BroadcastReceiver
-keep public class * extends android.content.ContentProvider
-keep public class * extends android.app.backup.BackupAgentHelper
-keep public class * extends android.preference.Preference
-keep public class com.android.vending.licensing.ILicensingService

-keepclasseswithmembernames class * {
    native <methods>;
}

-keepclasseswithmembernames class * {
    public <init>(android.content.Context, android.util.AttributeSet);
}

-keepclasseswithmembernames class * {
    public <init>(android.content.Context, android.util.AttributeSet, int);
}

-keepclassmembers enum * {
    public static **[] values();
    public static ** valueOf(java.lang.String);
}

-keep class * implements android.os.Parcelable {
  public static final android.os.Parcelable$Creator *;
}


code:
<?xml version='1.0' encoding='utf-8'?>
<resources>
    <array name="qt_libs">
        <item>QtCore</item>
        <item>QtGui</item>
        <item>QtNetwork</item>
        <item>QtScript</item>
        <item>QtSql</item>
        <item>QtSvg</item>
        <item>QtXmlPatterns</item>
        <item>QtDeclarative</item>
    </array>
    <array name="bundled_libs"/>
</resources>


code:
<?xml version='1.0' encoding='utf-8'?>
<resources>
    <string name="app_name">Ubuntu Developer Summit</string>
</resources>


code:
/*
    Copyright (c) 2009-2011, BogDan Vatra <bog_dan_ro@yahoo.com>
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions are met:
        * Redistributions of source code must retain the above copyright
        notice, this list of conditions and the following disclaimer.
        * Redistributions in binary form must reproduce the above copyright
        notice, this list of conditions and the following disclaimer in the
        documentation and/or other materials provided with the distribution.
        * Neither the name of the  BogDan Vatra <bog_dan_ro@yahoo.com> nor the
        names of its contributors may be used to endorse or promote products
        derived from this software without specific prior written permission.

    THIS SOFTWARE IS PROVIDED BY BogDan Vatra <bog_dan_ro@yahoo.com> ''AS IS'' AND ANY
    EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
    DISCLAIMED. IN NO EVENT SHALL BogDan Vatra <bog_dan_ro@yahoo.com> BE LIABLE FOR ANY
    DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
    (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
    ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
    SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

package eu.licentia.necessitas.industrius;

import java.io.File;
import java.io.IOException;
import java.util.ArrayList;
import java.util.Iterator;

import android.app.Activity;
import android.app.AlertDialog;
import android.content.ComponentName;
import android.content.Context;
import android.content.DialogInterface;
import android.content.Intent;
import android.content.ServiceConnection;
import android.content.pm.ActivityInfo;
import android.content.pm.PackageManager;
import android.content.pm.PackageManager.NameNotFoundException;
import android.content.res.Configuration;
import android.graphics.Rect;
import android.net.Uri;
import android.os.Bundle;
import android.os.IBinder;
import android.os.RemoteException;
import android.text.method.MetaKeyKeyListener;
import android.util.DisplayMetrics;
import android.util.Log;
import android.view.KeyCharacterMap;
import android.view.KeyEvent;
import android.view.Window;
import android.view.WindowManager;
import android.view.inputmethod.InputMethodManager;
import eu.licentia.necessitas.ministro.IMinistro;
import eu.licentia.necessitas.ministro.IMinistroCallback;

public class QtActivity extends Activity {

    private final static int MINISTRO_INSTALL_REQUEST_CODE = 0xf3ee;
    private static final int MINISTRO_API_LEVEL=1; // Ministro api level (check IMinistro.aidl file)
    private static final int NECESSITAS_API_LEVEL=1; // Necessitas api level.

    private String m_qtLibs[]=null;
    private int m_id=-1;
    private boolean softwareKeyboardIsVisible=false;
    private long m_metaState;
    private int m_lastChar=0;
    private boolean m_fullScreen=false;
    private boolean m_started = false;
    private QtSurface m_surface=null;
    private QtLayout m_layout=null;

    private void startApplication(String [] libs, String environment, String params)
    {
        QtApplication.loadQtLibraries(libs);
        try
        {
            ActivityInfo ai=getPackageManager().getActivityInfo(getComponentName(), PackageManager.GET_META_DATA);
            if (ai.metaData.containsKey("android.app.bundled_libs_resource_id"))
            {
                // Load bundle libs
                int resourceId = ai.metaData.getInt("android.app.bundled_libs_resource_id");
                QtApplication.loadBundledLibraries(getResources().getStringArray(resourceId));
            }

            if (ai.metaData.containsKey("android.app.lib_name")) // Load application
                QtApplication.loadBundledLibraries(new String[]{ai.metaData.getString("android.app.lib_name")});

            // if the applications is debuggable and it has a native debug request
            if ( /*(ai.flags&ApplicationInfo.FLAG_DEBUGGABLE) != 0
                    &&*/ getIntent().getExtras() != null
                    && getIntent().getExtras().containsKey("native_debug")
                    && getIntent().getExtras().getString("native_debug").equals("true"))
            {
                try
                {
                    String packagePath=getPackageManager().getApplicationInfo(getPackageName(), PackageManager.GET_CONFIGURATIONS).dataDir+"/";
                    String gdbserverPath=getIntent().getExtras().containsKey("gdbserver_path")?getIntent().getExtras().getString("gdbserver_path"):packagePath+"lib/gdbserver ";
                    String socket=getIntent().getExtras().containsKey("gdbserver_socket")?getIntent().getExtras().getString("gdbserver_socket"):"+debug-socket";
                    // start debugger
                    m_debuggerProcess =Runtime.getRuntime().exec(gdbserverPath+socket+" --attach "+android.os.Process.myPid(),null, new File(packagePath));
                }
                catch (IOException ioe)
                {
                        Log.e(QtApplication.QtTAG,"Can't start debugging"+ioe.getMessage());
                }
                catch (SecurityException se)
                {
                        Log.e(QtApplication.QtTAG,"Can't start debugging"+se.getMessage());
                }
            }
            // start application

            if (ai.metaData.containsKey("android.app.application_startup_params"))
            {
                if (params.length()>0)
                    params+="\t";
                params += ai.metaData.getString("android.app.application_startup_params");
            }

            final String homePath="HOME="+getFilesDir().getAbsolutePath()+"\tTMPDIR="+getFilesDir().getAbsolutePath();
            if (environment != null && environment.length()>0)
                environment=homePath+"\t"+environment;
            else
                environment=homePath;

            QtApplication.startApplication(params, environment);
            m_surface.applicationStared();
            m_started = true;
        }
        catch (NameNotFoundException e)
        {
            Log.e(QtApplication.QtTAG, "Can't package metadata", e);
        }
    }

    private IMinistroCallback m_ministroCallback = new IMinistroCallback.Stub() {
        @Override
        public void libs(final String[] libs, final String evnVars, final String params,
                         int errorCode, String errorMessage) throws RemoteException {
            runOnUiThread(new Runnable() {
                @Override
                public void run() {
                    startApplication(libs, evnVars, params);
                }
            });
        }
    };

    private ServiceConnection m_ministroConnection=new ServiceConnection() {
        private IMinistro m_service = null;
        @Override
        public void onServiceConnected(ComponentName name, IBinder service) {
            m_service = IMinistro.Stub.asInterface(service);
            try {
                    if (m_service!=null)
                            m_service.checkModules(m_ministroCallback, m_qtLibs, (String) QtActivity.this.getTitle(), MINISTRO_API_LEVEL, NECESSITAS_API_LEVEL);
            } catch (RemoteException e) {
                    e.printStackTrace();
            }
        }

        @Override
        public void onServiceDisconnected(ComponentName name) {
            m_service = null;
        }
    };

    private boolean m_quitApp = true;
    private Process m_debuggerProcess=null; // debugger process
    private void exitApplication()
    {
        AlertDialog errorDialog = new AlertDialog.Builder(QtActivity.this).create();
        errorDialog.setMessage("Can't find Ministro service.\nThe application can't start.");
        errorDialog.setButton("OK", new DialogInterface.OnClickListener() {
            public void onClick(DialogInterface dialog, int which) {
                finish();
            }
        });
        errorDialog.show();
    }

    private void startApp(final boolean firstStart)
    {
        try
        {
            ActivityInfo ai=getPackageManager().getActivityInfo(getComponentName(), PackageManager.GET_META_DATA);
            if (!ai.metaData.containsKey("android.app.qt_libs_resource_id"))
            {
                // No required qt libs ?
                // Probably this application was compiled using static qt libs
                // or all qt libs are prebundled into the package
                m_ministroCallback.libs(null, null, null, 0, null);
                return;
            }
            int resourceId = ai.metaData.getInt("android.app.qt_libs_resource_id");
            m_qtLibs=getResources().getStringArray(resourceId);
            if (getIntent().getExtras()!= null && getIntent().getExtras().containsKey("use_local_qt_libs")
                    && getIntent().getExtras().getString("use_local_qt_libs").equals("true"))
            {
                ArrayList<String> libraryList= new ArrayList<String>();
                for(int i=0;i<m_qtLibs.length;i++)
                {
                    libraryList.add("/data/local/qt/lib/lib"+m_qtLibs[i]+".so");
                }

                if (getIntent().getExtras().containsKey("load_local_libs"))
                {
                    String []extraLibs=getIntent().getExtras().getString("load_local_libs").split(";");
                    for (int i=0;i<extraLibs.length;i++)
                        libraryList.add("/data/local/qt/"+extraLibs[i]);
                }

                String[] libs=new String[libraryList.size()];
                libs=libraryList.toArray(libs);
                m_ministroCallback.libs(libs,"QT_IMPORT_PATH=/data/local/qt/imports\tQT_PLUGIN_PATH=/data/local/qt/plugins", "-platform\tandroid", 0,null);
                return;
            }

            try {
                if (!bindService(new Intent(eu.licentia.necessitas.ministro.IMinistro.class.getCanonicalName()), m_ministroConnection, Context.BIND_AUTO_CREATE))
                    throw new SecurityException("");
            } catch (SecurityException e) {
                if (firstStart)
                {
                    AlertDialog.Builder downloadDialog = new AlertDialog.Builder(this);
                    downloadDialog.setMessage("This application requires Ministro, Qt libaries for Android. Would you like to install it?");
                    downloadDialog.setPositiveButton("Yes", new DialogInterface.OnClickListener() {
                        public void onClick(DialogInterface dialogInterface, int i) {
                            try
                            {
                                Uri uri = Uri.parse("market://search?q=pname:eu.licentia.necessitas.ministro");
                                Intent intent = new Intent(Intent.ACTION_VIEW, uri);
                                startActivityForResult(intent, MINISTRO_INSTALL_REQUEST_CODE);
                            }
                            catch (Exception e) {
                                e.printStackTrace();
                                exitApplication();
                            }
                        }
                    });

                    downloadDialog.setNegativeButton("No", new DialogInterface.OnClickListener() {
                        public void onClick(DialogInterface dialogInterface, int i) {
                            QtActivity.this.finish();
                        }
                    });
                    downloadDialog.show();
                }
                else
                {
                    exitApplication();
                }
            }
        }
        catch (Exception e)
        {
            Log.e(QtApplication.QtTAG, "Can't create main activity", e);
        }
    }

    @Override
    protected void onActivityResult(int requestCode, int resultCode, Intent data)
    {
        if (requestCode == MINISTRO_INSTALL_REQUEST_CODE)
                startApp(false);
        super.onActivityResult(requestCode, resultCode, data);
    }

    @Override
    public void onCreate(Bundle savedInstanceState)
    {
        super.onCreate(savedInstanceState);
        requestWindowFeature(Window.FEATURE_NO_TITLE);
        m_quitApp = true;
        QtApplication.setMainActivity(this);
        if (null == getLastNonConfigurationInstance())
        {
            DisplayMetrics metrics = new DisplayMetrics();
            getWindowManager().getDefaultDisplay().getMetrics(metrics);
            QtApplication.setApplicationDisplayMetrics(metrics.widthPixels, metrics.heightPixels,
                            metrics.widthPixels, metrics.heightPixels,
                            metrics.xdpi, metrics.ydpi);
        }
        requestWindowFeature(Window.FEATURE_NO_TITLE);
        m_layout=new QtLayout(this);
        m_surface = new QtSurface(this, m_id);
        m_layout.addView(m_surface,0);
        setContentView(m_layout);
        m_layout.bringChildToFront(m_surface);
        if (null == getLastNonConfigurationInstance())
            startApp(true);
    }

    public QtLayout getQtLayout()
    {
        return m_layout;
    }

    @Override
    public Object onRetainNonConfigurationInstance()
    {
        super.onRetainNonConfigurationInstance();
        m_quitApp = false;
        return true;
    }

    @Override
    protected void onDestroy()
    {
        QtApplication.setMainActivity(null);
        super.onDestroy();
        if (m_quitApp)
        {
            Log.i(QtApplication.QtTAG, "onDestroy");
            if (m_debuggerProcess != null)
                m_debuggerProcess.destroy();
            System.exit(0);// FIXME remove it or find a better way
        }
        QtApplication.setMainActivity(null);
    }

    @Override
    protected void onResume()
    {
        // fire all lostActions
        synchronized (QtApplication.m_mainActivityMutex)
        {
            Iterator<Runnable> itr=QtApplication.getLostActions().iterator();
            while(itr.hasNext())
                runOnUiThread(itr.next());
                if (m_started)
                {
                    QtApplication.clearLostActions();
                    QtApplication.updateWindow();
                }
        }
        super.onResume();
    }

    public void redrawWindow(int left, int top, int right, int bottom) {
        m_surface.drawBitmap(new Rect(left, top, right, bottom));
    }

    public void setFullScreen(boolean enterFullScreen)
    {
        if (m_fullScreen == enterFullScreen)
            return;
        if (m_fullScreen = enterFullScreen)
            getWindow().addFlags(WindowManager.LayoutParams.FLAG_FULLSCREEN);
        else
            getWindow().clearFlags(WindowManager.LayoutParams.FLAG_FULLSCREEN);
    }

    @Override
    protected void onSaveInstanceState(Bundle outState) {
        super.onSaveInstanceState(outState);
        outState.putBoolean("FullScreen",m_fullScreen);
        outState.putBoolean("Started", m_started);
    }

    @Override
    protected void onRestoreInstanceState(Bundle savedInstanceState) {
        super.onRestoreInstanceState(savedInstanceState);
        setFullScreen(savedInstanceState.getBoolean("FullScreen"));
        m_started = savedInstanceState.getBoolean("Started");
        if (m_started)
            m_surface.applicationStared();
    }

    public void showSoftwareKeyboard()
    {
        softwareKeyboardIsVisible = true;
        InputMethodManager imm = (InputMethodManager)getSystemService(Context.INPUT_METHOD_SERVICE);
        imm.toggleSoftInput(InputMethodManager.SHOW_FORCED, InputMethodManager.HIDE_IMPLICIT_ONLY );
    }

    public void hideSoftwareKeyboard()
    {
        if (softwareKeyboardIsVisible)
        {
            InputMethodManager imm = (InputMethodManager)getSystemService(Context.INPUT_METHOD_SERVICE);
            imm.toggleSoftInput(0, 0);
        }
        softwareKeyboardIsVisible = false;
    }

    @Override
    public boolean dispatchKeyEvent(KeyEvent event) {
        if (m_started && event.getAction() == KeyEvent.ACTION_MULTIPLE &&
            event.getCharacters() != null &&
            event.getCharacters().length() == 1 &&
            event.getKeyCode() == 0) {
            Log.i(QtApplication.QtTAG, "dispatchKeyEvent at MULTIPLE with one character: "+event.getCharacters());
            QtApplication.keyDown(0, event.getCharacters().charAt(0), event.getMetaState());
            QtApplication.keyUp(0, event.getCharacters().charAt(0), event.getMetaState());
        }

        return super.dispatchKeyEvent(event);
    }

    @Override
    public boolean onKeyDown(int keyCode, KeyEvent event)
    {
        if (!m_started)
            return false;
        m_metaState = MetaKeyKeyListener.handleKeyDown(m_metaState, keyCode, event);
        int c = event.getUnicodeChar(MetaKeyKeyListener.getMetaState(m_metaState));
        int lc=c;
        m_metaState = MetaKeyKeyListener.adjustMetaAfterKeypress(m_metaState);

        if ((c & KeyCharacterMap.COMBINING_ACCENT) != 0)
        {
            c = c & KeyCharacterMap.COMBINING_ACCENT_MASK;
            int composed = KeyEvent.getDeadChar(m_lastChar, c);
            c = composed;
        }
        m_lastChar = lc;
//        if (keyCode != KeyEvent.KEYCODE_BACK)
                QtApplication.keyDown(keyCode, c, event.getMetaState());
        return true;
    }

    @Override
    public boolean onKeyUp(int keyCode, KeyEvent event)
    {
        if (!m_started)
            return false;
        m_metaState = MetaKeyKeyListener.handleKeyUp(m_metaState, keyCode, event);
        QtApplication.keyUp(keyCode, event.getUnicodeChar(), event.getMetaState());
        return true;
    }

    public void onConfigurationChanged(Configuration newConfig) {
        super.onConfigurationChanged(newConfig);
    }
}