diff --git a/goblins/ocapn/captp.rkt b/goblins/ocapn/captp.rkt index e1d946e..d37b756 100644 --- a/goblins/ocapn/captp.rkt +++ b/goblins/ocapn/captp.rkt @@ -82,8 +82,7 @@ method ;; Either arguments to the method or to the procedure, depending ;; on whether method exists - args - kw-args) + args) marshall::op:deliver-only unmarshall::op:deliver-only) ;; Queue a delivery of verb(args..) to recip, binding answer/rdr to the outcome. @@ -91,7 +90,6 @@ (to-desc method args - kw-args answer-pos resolve-me-desc) ; a resolver, probably an import (though it could be a handoff) marshall::op:deliver unmarshall::op:deliver) @@ -621,6 +619,8 @@ ($ coordinator 'make-handoff-base-cert obj)])] [(? void?) (record* 'void)] + [(? keyword?) + (record* 'kw-arg (string->symbol (keyword->string obj)))] ;; TODO: Supply more machine-crossing exception types here [(? exn:fail?) (record* 'exn:fail:mystery)] @@ -650,6 +650,8 @@ (make-mystery-fail)] [(record 'void '()) (void)] + [(record 'kw-arg (list keyword)) + (string->keyword (symbol->string keyword))] ;; unserialize user-defined records [(record 'user-record (list record-tag record-args)) (record record-tag record-args)] @@ -719,6 +721,17 @@ (send-to-remote (op:abort reason)) (tear-it-down)) + (define (find-and-collect-keyword-args raw-args) + (for/fold ([args '()] + [kw-args '()] + [kw-vals '()] + [next-kw-val? #f] + #:result (values (reverse args) (reverse kw-args) (reverse kw-vals))) + ([arg raw-args]) + (cond [next-kw-val? (values args kw-args (cons arg kw-vals) #f)] + [(keyword? arg) (values args (cons arg kw-args) kw-vals #t)] + [else (values (cons arg args) kw-args kw-vals #f)]))) + ;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ;; TODO TODO TODO: EACH of these needs to call (handle-spare-imports!) ;; at the end of its behavior! Probably the best thing to do is to @@ -742,35 +755,29 @@ ;; TODO: Handle case where the target doesn't exist? ;; Or maybe just generally handle unmarshalling errors :P [(op:deliver-only to-desc method - args-marshalled - kw-args-marshalled) + args-marshalled) (define args (incoming-post-unmarshall! args-marshalled)) - (define kw-args - (incoming-post-unmarshall! kw-args-marshalled)) + (define target (unmarshall-to-desc to-desc)) - (define-values (kws kw-vals) - (kws-hasheq->kws-lists kw-args)) - (keyword-apply <-np kws kw-vals - target args) + (apply <-np target args) (void)] [(op:deliver to-desc method args-marshalled - kw-args-marshalled ;; answer-pos is either an integer (promise pipelining) ;; or #f (no pipelining) (and (or (? integer?) #f) answer-pos) resolve-me-desc) - (define args + (define raw-args (incoming-post-unmarshall! args-marshalled)) - (define kw-args - (incoming-post-unmarshall! kw-args-marshalled)) + + (define-values (args kw-args kw-vals) + (find-and-collect-keyword-args raw-args)) + (define target (unmarshall-to-desc to-desc)) - (define-values (kws kw-vals) - (kws-hasheq->kws-lists kw-args)) (define sent-promise - (keyword-apply <- kws kw-vals target args)) + (keyword-apply <- kw-args kw-vals target args)) ;; We're either resolving the to the answer promise we create ;; or we're resolving to the actual object described by resolve-me-desc ;; @@ -843,15 +850,11 @@ #f ;; TODO: support methods ;; TODO: correctly marshall everything here (outgoing-pre-marshall! args) - (outgoing-pre-marshall! - (kws-lists->kws-hasheq kws kw-vals)) answer-pos (marshall-local-refr! resolve-me)) (op:deliver-only (marshall-to to) #f ;; TODO: support methods - (outgoing-pre-marshall! args) - (outgoing-pre-marshall! - (kws-lists->kws-hasheq kws kw-vals))))) + (outgoing-pre-marshall! args)))) (send-to-remote deliver-msg)] [(cmd-send-listen (? remote-refr? to-refr) (? local-refr? listener-refr) (? boolean? wants-partial?)) @@ -942,7 +945,7 @@ ;; TODO TODO TODO: We need to make use of this and also check the ;; session listed on the receive certificate to prevent a replay ;; attack - (define remote-handoff-count 0) + (define remote-handoff-coont 0) (define handoff-pubkey (pk-key->public-only-key handoff-privkey))