hbs2/bf6/hbs2

#! /usr/bin/env -S hbs2-cli file

; # println *args

; # (println (grep (sym "-g") *args))

(define (--help)
  (begin
    (println [concat

"hbs2-cli wrapper"           chr:lf
"supported commands list:"   chr:lf
"  "

             ])
  )
)

(match *args

  ( (list? [sym? store] ...)
    (begin
      (local optdef
        `( [-g          1 GROUPKEY]
           [--group-key 1 GROUPKEY] ))

      (local split (cli:split optdef ...))
      (local opts (nth 0 split))
      (local args (nth 1 split))

      (local gk (@? GROUPKEY opts))
      (local fname (head args))

      (local kwa `[ ,(if gk [list :gk gk] '() ) ])

      ; (display kwa)

      (println
        (if fname
          (hbs2:tree:metadata:file kwa fname)
          (hbs2:tree:metadata:stdin kwa)))
    )
  )

  ( (list? [sym? hash] ...)
    (begin
      (local what (if (eq? (type ...) :list) ... '()))
      (display (eval `(hbs2:hash ,@what)))
    )
  )

  ( (list? [sym? has] hash)
    (begin
      (local s (hbs2:peer:storage:block:size hash))
      (cond
        ( (eq? :no-block s) (die))
        ( _ (print s))
      ))
  )

  ( (list? [sym? cat] ...)

      (begin

        (local optdef `( [-H           0 HASHES]
                         [--raw        0 RAW]
                         [--metadata   0 META]
                         [--m          0 META]
                       ))

        (local parsed (cli:split optdef ...))
        (local opts (nth 0 parsed))
        (local hash (head (nth 1 parsed)))

        (if (@? HASHES opts)
          (begin
            (iterate [fn x . println x] [tail [hbs2:tree:scan:deep hash]])
            (quit)
        ))


        (if (@? RAW    opts)
          (begin
            (bytes:put (hbs2:peer:storage:block:get hash))
            (quit)
          )
        )

        (if (@? META opts)
          (begin
            (display (hbs2:tree:metadata:get hash))
            (quit)
          )
        )

        (hbs2:tree:read:stdout hash)

      )
  )

  ( (list? [sym? del] ...)

      (begin

        (local optdef `( [-y       0 YES]
                         [-r       0 REC]
                       ))

        (local parsed (cli:split optdef ...))
        (local opts (nth 0 parsed))
        (local hash (head (nth 1 parsed)))

        (local hashes
          (cond
            ( (@? REC opts)  (hbs2:tree:scan:deep hash) )
            ( _              (hbs2:tree:scan hash)  )
          )
        )

        (define (ask ha)
            (if (@? YES opts) true
            (begin
              (print "deleting " ha " ")
              (print "sure [y/n]? ") (flush:stdout)
              (local answ (str:getchar:stdin))
              (newline)
              (eq? (upper answ) "Y")
            ))
        )

        (cond
          ( (and (@? YES opts) (@? REC opts)) (hbs2:tree:delete hash))
          ( _
            (for (reverse hashes)
              [fn ha .
                  [begin
                    (local y (or (@? YES opts) (ask ha)))
                    (if y
                      (begin
                        (hbs2:peer:storage:block:del ha)
                     ))
                  ]])
          )
        )


      )

  )

  ( (list? [sym? keyring] [sym? new] ...)
      (begin

        (local optdef `( [-n       1 NUM]
                         [--number 1 NUM]
                       ))

        (local opts (nth 0 (cli:split optdef ...)))
        ;  (println opts)
        (print (hbs2:keyring:new (@? NUM opts)))
      )
  )

  ( (list? [sym? reflog] [sym? get] hash)
    (display (hbs2:reflog:get hash))
  )

  ( (list? [sym? reflog] [sym? fetch] hash)
    (hbs2:reflog:fetch hash)
  )

  ( (list? [sym? metadata] [sym? dump] hash)
    (display (hbs2:tree:metadata:get hash))
  )

  ( (list? [sym? deps] hash)
    (iterate println (hbs2:tree:scan:deep hash) )
  )

  ( (list? [sym? fsck] [sym? -h])
    (begin
      (println "usage: hbs2 fsck <PATH>")
      (println "default for <PATH> is hbs2-peer storage path")
    )
  )

  ( (list? [sym? fsck] ...)
    (begin
      (local sto1 (if (eq? (type ...) :list) (car ...) '()))
      (if sto1
        (run:proc:attached tcq ncq:fsck (concat sto1 :/ :0))
        (begin
          (local answ (fallback #f '(call:proc hbs2-peer poke)))
          (unless answ (die "hbs2-peer seems down, but you may pass storage directory manually"))
          (local sto (lookup:uw storage: answ))
          (println (ansi :red _ "check") space sto)
          (run:proc:attached tcq ncq:fsck (concat sto :/ :0))
        )
      )
    )
  )

  ( _  (--help) )
)

; vim: filetype=scheme syntax=scheme