src/TeXmacs/progs/remote/crypt.scm

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : crypt.scm
   5 ;; DESCRIPTION : basic routines for cryptography
   6 ;; COPYRIGHT   : (C) 2006  Joris van der Hoeven
   7 ;;
   8 ;; This software falls under the GNU general public license version 3 or later.
   9 ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
  10 ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
  11 ;;
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13
  14 (texmacs-module (remote crypt))
  15
  16 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17 ;; Further utilities for files
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19
  20 (tm-define-macro (with-temp-file name s . body)
  21   `(let* ((tmp-u (url-temp))
  22           (,name (escape-shell (url-concretize tmp-u))))
  23      (string-save ,s tmp-u)
  24      (with r (begin ,@body)
  25        (system-remove tmp-u)
  26        r)))
  27
  28 (tm-define (system* . args)
  29   (system (apply string-append args)))
  30
  31 (tm-define (eval-system* . args)
  32   (eval-system (apply string-append args)))
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 ;; Conversion to and from base 64
  36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37
  38 (tm-define (string->base64 s)
  39   (with-temp-file message s
  40     (string-replace (eval-system* "openssl enc -base64 -in " message)
  41                     "\n" "#")))
  42
  43 (tm-define (base64->string s)
  44   (with-temp-file message (string-replace s "#" "\n")
  45     (eval-system* "openssl enc -d -base64 -in " message)))
  46
  47 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  48 ;; Crypting with RSA
  49 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  50
  51 (tm-define (rsa-generate)
  52   (eval-system* "openssl genrsa 2048 2> /dev/null"))
  53
  54 (tm-define (rsa-private->public private-key)
  55   (with-temp-file key private-key
  56     (eval-system* "openssl rsa -in " key " -pubout 2> /dev/null")))
  57
  58 (tm-define (rsa-encode what public-key)
  59   (with-temp-file msg what
  60     (with-temp-file key public-key
  61       (eval-system* "openssl rsautl -in " msg
  62                     " -pubin -inkey " key " -encrypt"))))
  63
  64 (tm-define (rsa-decode what private-key)
  65   (with-temp-file msg what
  66     (with-temp-file key private-key
  67       (eval-system* "openssl rsautl -in " msg
  68                     " -inkey " key " -decrypt"))))
  69
  70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71 ;; Crypting with DES3
  72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73
  74 (tm-define (secret-generate . len)
  75   (with l (if (null? len) 32 (car len))
  76     (eval-system* "openssl rand -base64 " (number->string l))))
  77
  78 (tm-define (secret-encode what secret-key)
  79   (with-temp-file msg what
  80     (with-temp-file key secret-key
  81       (eval-system* "openssl aes-256-cbc -nosalt -in " msg
  82                     " -pass file:" key))))
  83
  84 (tm-define (secret-decode what secret-key)
  85   (with-temp-file msg what
  86     (with-temp-file key secret-key
  87       (eval-system* "openssl aes-256-cbc -nosalt -d -in " msg
  88                     " -pass file:" key))))
  89
  90 (tm-define (secret-hash password)
  91   (with-temp-file pass password
  92     (secret-encode "TeXmacs worgelt BlauwBilGorgels" password)))
  93
  94 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  95 ;; Prevent third persons to pretend being one of the communicants
  96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97
  98 (tm-define (add-verification msg)
  99   (string-append "tm:" msg))
 100
 101 (tm-define (remove-verification msg)
 102   (and (string? msg)
 103        (>= (string-length msg) 3)
 104        (== (substring msg 0 3) "tm:")
 105        (substring msg 3 (string-length msg))))