;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix 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. ;;; ;;; GNU Guix 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 GNU Guix. If not, see . (define-module (test-records) #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (guix records)) (define (test-module) ;; A module in w
aboutsummaryrefslogtreecommitdiff
blob: d0cfb8f7a347994e94edbc2b816347ebb6079b3a (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2020 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages mcrypt)
  #:use-module (guix packages)
  #:use-module ((guix licenses) #:select (gpl2+))
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages perl))

(define-public mcrypt
  (package
    (name "mcrypt")
    (version "2.6.8")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "mirror://sourceforge/mcrypt/MCrypt/"
                          version "/" name "-" version ".tar.gz"))
      (sha256
       (base32
        "161031n1w9pb4yzz9i47szc12a4mwpcpvyxnvafsik2l9s2aliai"))
      (patches (search-patches
                 "mcrypt-CVE-2012-4409.patch"
                 "mcrypt-CVE-2012-4426.patch"
                 "mcrypt-CVE-2012-4527.patch"))))
    (build-system gnu-build-system)
    (inputs
     `(("zlib" ,zlib)
       ("libmcrypt" ,libmcrypt)
       ("libmhash" ,libmhash)))
    (home-page "http://mcrypt.sourceforge.net/")
    (synopsis "Replacement for the popular Unix crypt command")
    (description
     "MCrypt is a replacement for the old crypt() package and crypt(1)
command, with extensions.  It allows developers to use a wide range of
encryption functions, without making drastic changes to their code.  It allows
users to encrypt files or data streams without having to be cryptographers.
The companion to MCrypt is Libmcrypt, which contains the actual encryption
functions themselves, and provides a standardized mechanism for accessing
them.")
    (license gpl2+)))

(define-public libmcrypt
  (package
    (name "libmcrypt")
    (version "2.5.8")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "mirror://sourceforge/mcrypt/Libmcrypt/" version
                          "/libmcrypt-" version ".tar.gz"))
      (sha256
       (base32
        "0gipgb939vy9m66d3k8il98rvvwczyaw2ixr8yn6icds9c3nrsz4"))))
    (build-system gnu-build-system)
    (home-page "http://mcrypt.sourceforge.net/")
    (synopsis "Encryption algorithm library")
    (description
     "Libmcrypt is a data encryption library.  The library is thread safe and
provides encryption and decryption functions.  This version of the library
supports many encryption algorithms and encryption modes.  Some algorithms
which are supported: SERPENT, RIJNDAEL, 3DES, GOST, SAFER+, CAST-256, RC2,
XTEA, 3WAY, TWOFISH, BLOWFISH, ARCFOUR, WAKE and more.")
    (license gpl2+)))

(define-public libmhash
  (package
    (name "libmhash")
    (version "0.9.9.9")
    (source
     (origin
      (method url-fetch)
      (uri (string-append "mirror://sourceforge/mhash/mhash/" version
                          "/mhash-" version ".tar.bz2"))
      (sha256
       (base32
        "1w7yiljan8gf1ibiypi6hm3r363imm3sxl1j8hapjdq3m591qljn"))
      (patches (search-patches "mhash-keygen-test-segfault.patch"
                               "libmhash-hmac-fix-uaf.patch"))))
    (build-system gnu-build-system)
    (native-inputs
     `(("perl" ,perl)))                 ;for tests
    (home-page "http://mhash.sourceforge.net/")
    (synopsis "Thread-safe hash library")
    (description
     "Mhash is a thread-safe hash library, implemented in C, and provides a
uniform interface to a large number of hash algorithms.  These algorithms can
be used to compute checksums, message digests, and other signatures.  The HMAC
support implements the basics for message authentication, following RFC 2104.

Algorithms currently supplied are:

CRC-32, CRC-32B, ALDER-32, MD-2, MD-4, MD-5, RIPEMD-128, RIPEMD-160,
RIPEMD-256, RIPEMD-320, SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, HAVAL-128,
HAVAL-160, HAVAL-192, HAVAL-256, TIGER, TIGER-128, TIGER-160, GOST, WHIRLPOOL,
SNEFRU-128, SNEFRU-256.")
    (license gpl2+)))
(foo (baz 'what?))) (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "extra.*initializer.*baz" message) (eq? proc 'foo))))) (test-assert "define-record-type* & inherit & extra initializers" (catch 'syntax-error (lambda () (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (foo (inherit (foo)) (baz 'what?))) (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "extra.*initializer.*baz" message) (eq? proc 'foo))))) (test-assert "define-record-type* & duplicate initializers" (let ((exp '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (foo (bar 1) (bar 2)))) (loc (current-source-location))) ;keep this alignment! (catch 'syntax-error (lambda () (eval exp (test-module)) #f) (lambda (key proc message location form . args) (and (string-match "duplicate.*initializer" message) (eq? proc 'foo) ;; Make sure the location is that of the field specifier. (lset= equal? (pk 'expected-loc `((line . ,(- (assq-ref loc 'line) 1)) ,@(alist-delete 'line loc))) (pk 'actual-loc location))))))) (test-assert "ABI checks" (let ((module (test-module))) (eval '(begin (define-record-type* foo make-foo foo? (bar foo-bar (default 42))) (define (make-me-a-record) (foo))) module) (unless (eval '(foo? (make-me-a-record)) module) (error "what?" (eval '(make-me-a-record) module))) ;; Redefine with an additional field. (eval '(define-record-type* foo make-foo foo? (baz foo-baz) (bar foo-bar (default 42))) module) ;; Now 'make-me-a-record' is out of sync because it does an ;; 'allocate-struct' that corresponds to the previous definition of . (catch 'record-abi-mismatch-error (lambda () (eval '(foo? (make-me-a-record)) module) #f) (match-lambda* ((key 'abi-check (? string? message) (rtd) . _) (eq? rtd (eval ' module))))))) (test-equal "recutils->alist" '((("Name" . "foo") ("Version" . "0.1") ("Synopsis" . "foo bar") ("Something_else" . "chbouib")) (("Name" . "bar") ("Version" . "1.5"))) (let ((p (open-input-string " # Comment following an empty line, and # preceding a couple of empty lines, all of # which should be silently consumed. Name: foo Version: 0.1 # Comment right in the middle, # spanning two lines. Synopsis: foo bar Something_else: chbouib # Comment right before. Name: bar Version: 1.5 # Comment at the end."))) (list (recutils->alist p) (recutils->alist p)))) (test-equal "recutils->alist with + lines" '(("Name" . "foo") ("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space.")) (recutils->alist (open-input-string " Name: foo Description: 1st line, + 2nd line, + 3rd line with extra space, +4th line without space."))) (test-equal "alist->record" '((1 2) b c) (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2)) list '("a" "b" "c") '("a"))) (test-end)