Coverage report: /development/source/library/org/datagraph/spocq-shard/src/shell/test-authorization.lisp

KindCoveredAll%
expression0118 0.0
branch08 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; -*- Mode: lisp; Syntax: ansi-common-lisp; Base: 10; Package: org.datagraph.spocq.implementation; -*-
2
 
3
 (in-package :org.datagraph.spocq.implementation)
4
 
5
 #|
6
 test access authorization for a specified againt against either
7
 an account or a repository.
8
 
9
 sbcl --core sbcl-spocq.core
10
 (sb-ext:save-lisp-and-die "test-authorization" :executable t :toplevel #'spocq.i::main-test-authorization)
11
 
12
 |#
13
 
14
 (defparameter *mode-map*
15
   '(("read" |acl|:|Read|)
16
     ("write" |acl|:|Write|)
17
     ("update" |acl|:|Write|)
18
     ("create" |acl|:|Control|)
19
     ("destroy" |acl|:|Control|)))
20
    
21
 (defparameter *metadata-repository-id* "")
22
 
23
 (defun main-test-authorization (&rest args &key
24
                                       (account (getarg "--account"))
25
                                       (agent (getarg "--agent"))
26
                                       (mode (getarg "--mode"))
27
                                       (repository (getarg "--repository"))
28
                                       (token (getarg "--token"))
29
                                       (verbose (or (getarg "-v") (getarg "--verbose")))
30
                                       &allow-other-keys)
31
   
32
   (handler-bind ((serious-condition
33
                   (lambda (condition)
34
                     (log-stacktrace "Error in authorizationtesting: ~s -> ~a." args condition)
35
                     (format *standard-output* "~a~%" condition)
36
                     (when *exit-on-errors*
37
                       (stop)
38
                       (exit-lisp 70)))))
39
       ;; need to generate the task id as, to this point, the store connection has not been initialized
40
       (with-command-line-configuration ((list* :task-id (prin1-to-string (uuid:make-v1-uuid)) args))
41
         (setq *start-timestamp* (iso-time))
42
         (initialize-spocq :title (or (getarg "--title") "authorization"))
43
         (log-debug "test-authorization: ~a" args)
44
         (cond (account
45
                (unless (every #'alphanumericp account)
46
                  (error "Invalid account name ~s." account))
47
                (setf *metadata-repository-id* (compute-repository-id account "system"))
48
                (setf account (compute-account-identifier account)))
49
               (repository
50
                (multiple-value-bind (account-name repository-name)
51
                                     (parse-repository-id repository)
52
                  (unless (and account-name repository-name)
53
                    (error "Invalid repository id: ~s." repository))
54
                  (setf *metadata-repository-id* (compute-repository-id account-name "system"))
55
                  (setf repository (compute-repository-identifier account-name repository-name))))
56
               (t
57
                (error "Either a repository or an account target must be supplied: ~s."
58
                       (command-line-argument-list))))
59
         (cond (agent
60
                (setf agent (compute-user-identifier agent)))
61
               (token
62
                (setf agent (agent-authenticated-by-token token :if-does-not-exist :error)))
63
               (t ;; anonymous
64
                (setf agent (ensure-agent))))
65
         (setf mode (loop for (arg canonical-mode) in *mode-map*
66
                      when (equalp arg mode)
67
                      return canonical-mode
68
                      finally (error "Invalid mode: ~s." mode)))
69
         (when verbose
70
           (trace run-sparql query-capability))
71
         (let ((result (query-capability *metadata-repository-id*
72
                                         agent
73
                                         (or repository account)
74
                                         mode)))
75
           (when verbose (print result *standard-output*) (fresh-line *standard-output*))
76
           (if (interactive-stream-p *standard-input*)
77
               result
78
               (if result
79
                   (exit-lisp 0)
80
                   (exit-lisp 1)))))))
81
 
82
 
83
 ;;; (main-test-authorization)