#!/usr/bin/guile
!#

(import (sph filesystem) (sph hashtable)
  (sph io) (sph list)
  (sph number) (sph other)
  (sph process) (sph string) (sph vector) (sph) (sph alist) (sph lang indent-syntax) (sph cli))

(define (format-encrypt target-device-path run?)
  (let (device-mapper-path (string-replace-char target-device-path #\/ #\_))
    (if (string-null? (shell-eval->string (string-append "mount |grep " device-mapper-path)))
      (let
        (commands
          (list
            #;(list "dd" "if=/dev/urandom"
              (string-append "of=" target-device-path) "bs=512" "count=4000")
            (list "cryptsetup" "luksFormat" target-device-path)
            (list "cryptsetup" "luksOpen" target-device-path device-mapper-path)
            (list "mkfs.ext4" (string-append "/dev/mapper/" device-mapper-path))
            (list "cryptsetup" "luksClose" (string-append "/dev/mapper/" device-mapper-path))))
        (if run? (apply execute-and commands)
          (each (l (e) (display (string-join e " ")) (newline)) commands)))
      (display "target device is mounted. please unmount it first\n"))))

(define (string-lines . a) (string-join a "  \n"))

(define (run)
  (let*
    ( (dependencies (list "cryptsetup" "dd" "grep" "mkfs.ext4" "mount" "/dev/urandom"))
      (description
        (list "encrypt and format a block device or a container file with cryptsetup and luks."
          "all previously existing data on the device or in the file will be deleted."
          "uses luksFormat default options."
          "no modifications are made unless the --run option has been specified"))
      (about
        (prefix-tree->indent-tree
          (qq
            ( ("description" (unquote-splicing description))
              ("depends on" (unquote (string-join dependencies " ")))
              ("maintainer and copyright" "sph@posteo.eu | http://sph.mn") ("license" "gpl3+")))))
      (options
        ( (cli-create #:about about
            #:description (string-join description "\n  ") #:options (q ( ((path)) (run)))))))
    (format-encrypt (alist-ref-q options path) (alist-ref-q options run))))

(run)