Changeset 15849 in project


Ignore:
Timestamp:
09/13/09 12:49:43 (10 years ago)
Author:
sjamaan
Message:

Improve exception handling (thanks to DerGuteMoritz?)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/estraier-client/estraier-client.scm

    r15848 r15849  
    5555    (if (eof-object? line) (void) (loop (read-line in)))))
    5656
    57 (define (exec uri writer reader)
    58   ;; Estraier doesn't understand the preferred ";" separator
    59   (parameterize ((form-urlencoded-separator "&"))
    60     (call-with-input-request uri writer reader)))
     57(define (http->estraier-exn exn loc specific . rest)
     58  (make-composite-condition
     59   (make-property-condition
     60    'exn 'location loc
     61    'message ((condition-property-accessor 'exn 'message) exn))
     62   (make-property-condition 'estraier-client)
     63   (apply make-property-condition specific rest)))
     64
     65(define (exec loc uri writer reader)
     66  (condition-case
     67      ;; Estraier doesn't understand the preferred ";" separator
     68      (parameterize ((form-urlencoded-separator "&"))
     69        (call-with-input-request uri writer reader))
     70    (exn (client-error)
     71         (case (response-code
     72                ((condition-property-accessor 'client-error 'response) exn))
     73           ((400) (signal (http->estraier-exn exn loc 'args)))
     74           ((401) (signal (http->estraier-exn exn loc 'auth)))
     75           ((403) (signal (http->estraier-exn exn loc 'perm)))
     76           ((404) (signal (http->estraier-exn exn loc 'node)))
     77           ((500) (signal (http->estraier-exn exn loc 'server)))
     78           (else  (signal exn))))))
    6179
    6280;; Read one block of data. The Hyper Estraier API sends data out in blocks
     
    92110(define (get-node-info base-uri node)
    93111  (exec
     112   'get-node-info
    94113   (node-uri base-uri node "inform")
    95114   #f
     
    110129
    111130(define (get-cache-usage base-uri node)
    112   (string->number (exec (node-uri base-uri node "cacheusage") #f read-line)))
     131  (string->number
     132   (exec 'get-cache-usage (node-uri base-uri node "cacheusage") #f read-line)))
    113133
    114134(define (optimize-node base-uri node)
    115   (exec (node-uri base-uri node "optimize") #f discard-output))
     135  (exec 'optimize-node (node-uri base-uri node "optimize") #f discard-output))
    116136
    117137(define (sync-node base-uri node)
    118   (exec (node-uri base-uri node "sync") #f discard-output))
     138  (exec 'sync-node (node-uri base-uri node "sync") #f discard-output))
    119139
    120140(define (list-documents base-uri node #!key max prev)
    121   (exec (node-uri base-uri node "list" query: `((max . ,max) (prev . ,prev)))
     141  (exec 'list-documents
     142        (node-uri base-uri node "list" query: `((max . ,max) (prev . ,prev)))
    122143        #f
    123144        (lambda (in)
     
    156177(define (put-document base-uri node contents attribs)
    157178  (exec
     179   'put-document
    158180   (make-request uri: (node-uri base-uri node "put_doc")
    159181                 method: 'POST major: 1 minor: 0
     
    165187
    166188(define (delete-document base-uri node #!key id uri)
    167   (exec (node-uri base-uri node "out_doc" query: (id/uri->alist id uri))
     189  (exec 'delete-document
     190        (node-uri base-uri node "out_doc" query: (id/uri->alist id uri))
    168191        #f discard-output))
    169192
    170193(define (document-uri->id base-uri node uri)
    171   (exec (node-uri base-uri node "uri_to_id"
     194  (exec 'document-uri->id
     195        (node-uri base-uri node "uri_to_id"
    172196                  query: `((uri . ,uri))) #f read-line))
    173197
     
    175199  (apply values
    176200         (exec
     201          'get-document
    177202          (node-uri base-uri node "get_doc" query: (id/uri->alist id uri))
    178203          #f (lambda (in)
     
    185210(define (update-attributes base-uri node attribs)
    186211  (exec
     212   'update-attributes
    187213   (make-request uri: (node-uri base-uri node "edit_doc")
    188214                 method: 'POST major: 1 minor: 0
     
    194220
    195221(define (document-attribute base-uri node attrib #!key id uri)
    196   (exec (node-uri base-uri node "get_doc_attr"
     222  (exec 'document-attribute
     223        (node-uri base-uri node "get_doc_attr"
    197224                  query: (cons `(attr . ,attrib) (id/uri->alist id uri)))
    198225        #f read-line))
    199226
    200227(define (document-keywords base-uri node #!key id uri)
    201   (exec (node-uri base-uri node "etch_doc" query: (id/uri->alist id uri))
     228  (exec 'document-keywords
     229        (node-uri base-uri node "etch_doc" query: (id/uri->alist id uri))
    202230        #f
    203231        (lambda (in)
     
    228256   (apply
    229257    values
    230     (exec (node-uri base-uri node "search"
     258    (exec 'find-documents
     259          (node-uri base-uri node "search"
    231260                    query: `((phrase . ,phrase) (order . ,order)
    232261                             (max . ,max)       (options . ,options)
     
    280309              (list documents meta)))))))
    281310
    282 (define (_set-user base-uri node name mode)
    283   (exec (node-uri base-uri node "_set_user"
    284                   query: `((name . ,name) (mode . ,mode)))
     311(define (_set-user loc base-uri node name mode)
     312  (exec loc (node-uri base-uri node "_set_user"
     313                      query: `((name . ,name) (mode . ,mode)))
    285314        #f read-lines))
    286315
    287316(define (unregister-user base-uri node name)
    288   (_set-user base-uri node name 0))
     317  (_set-user 'unregister-user base-uri node name 0))
    289318
    290319(define (register-admin-user base-uri node name)
    291   (_set-user base-uri node name 1))
     320  (_set-user 'register-admin-user base-uri node name 1))
    292321
    293322(define (register-guest-user base-uri node name)
    294   (_set-user base-uri node name 2))
     323  (_set-user 'register-guest-user base-uri node name 2))
    295324
    296325;; TODO: _set_link
     
    302331                 (apply update-uri base-uri args)
    303332                 (apply update-uri (uri-reference base-uri) args))))
    304     (update-uri uri
    305                 path: (append (uri-path uri) (list "master"))
     333    (update-uri (uri-relative-to (uri-reference "./master") uri)
    306334                query: (alist-update! 'action action (uri-query uri)))))
    307335
    308336(define (shutdown-master base-uri)
    309   (exec (master-uri base-uri "shutdown") #f discard-output))
     337  (exec 'shutdown-master (master-uri base-uri "shutdown") #f discard-output))
    310338
    311339(define (sync-master base-uri)
    312   (exec (master-uri base-uri "sync") #f discard-output))
     340  (exec 'sync-master (master-uri base-uri "sync") #f discard-output))
    313341
    314342(define (backup-master base-uri)
    315   (exec (master-uri base-uri "backup") #f discard-output))
     343  (exec 'backup-master (master-uri base-uri "backup") #f discard-output))
    316344
    317345(define (rotate-log base-uri)
    318   (exec (master-uri base-uri "logrtt") #f discard-output))
     346  (exec 'rotate-log (master-uri base-uri "logrtt") #f discard-output))
    319347
    320348(define (list-nodes base-uri)
    321349  (map (lambda (line)
    322350         (string-split line "\t" #t))
    323        (exec (master-uri base-uri "nodelist") #f read-lines)))
     351       (exec 'list-nodes (master-uri base-uri "nodelist") #f read-lines)))
    324352
    325353(define (add-node base-uri node-name #!optional node-label)
    326   (exec (master-uri base-uri "nodeadd"
     354  (exec 'add-node
     355        (master-uri base-uri "nodeadd"
    327356                    query: `((name . ,node-name) (label . ,node-label)))
    328357        #f discard-output))
    329358
    330359(define (delete-node base-uri node-name)
    331   (exec (master-uri base-uri "nodedel" query: `((name . ,node-name)))
     360  (exec 'delete-node
     361        (master-uri base-uri "nodedel" query: `((name . ,node-name)))
    332362        #f discard-output))
    333363
    334364(define (clear-node base-uri node-name)
    335   (exec (master-uri base-uri "nodeclr" query: `((name . ,node-name)))
     365  (exec 'clear-node
     366        (master-uri base-uri "nodeclr" query: `((name . ,node-name)))
    336367        #f discard-output))
    337368
    338369(define (list-users base-uri)
    339   (exec (master-uri base-uri "userlist")
     370  (exec 'list-users
     371        (master-uri base-uri "userlist")
    340372        #f
    341373        (lambda (in)
     
    349381(define (add-user base-uri username password
    350382                  #!key flags fullname description)
    351   (exec (make-request uri: (master-uri base-uri "useradd")
     383  (exec 'add-user
     384        (make-request uri: (master-uri base-uri "useradd")
    352385                      method: 'POST major: 1 minor: 0)
    353386        `((name . ,username) (passwd . ,password)
     
    356389
    357390(define (delete-user base-uri username)
    358   (exec (master-uri base-uri "userdel" query: `((name . ,username)))
     391  (exec 'delete-user
     392        (master-uri base-uri "userdel" query: `((name . ,username)))
    359393        #f discard-output))
    360394
Note: See TracChangeset for help on using the changeset viewer.