ceph/src/jaegertracing/thrift/test/cl/make-test-client.lisp

   1 (in-package #:cl-user)
   2
   3 ;;;; Licensed under the Apache License, Version 2.0 (the "License");
   4 ;;;; you may not use this file except in compliance with the License.
   5 ;;;; You may obtain a copy of the License at
   6 ;;;;
   7 ;;;;     http://www.apache.org/licenses/LICENSE-2.0
   8 ;;;;
   9 ;;;; Unless required by applicable law or agreed to in writing, software
  10 ;;;; distributed under the License is distributed on an "AS IS" BASIS,
  11 ;;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12 ;;;; See the License for the specific language governing permissions and
  13 ;;;; limitations under the License.
  14
  15 #+(or) (when (not (boundp 'sb-impl::default-external-format)
  16                  (setf sb-impl::default-external-format :UTF-8)))
  17
  18 (require "asdf")
  19 (load (merge-pathnames "../../lib/cl/load-locally.lisp" *load-truename*))
  20 (asdf:load-system :net.didierverna.clon)
  21 (asdf:load-system :fiasco)
  22 (asdf:load-asd (merge-pathnames "gen-cl/ThriftTest/thrift-gen-ThriftTest.asd" *load-truename*))
  23 (asdf:load-system :thrift-gen-thrifttest)
  24
  25 (net.didierverna.clon:nickname-package)
  26
  27 (defpackage #:thrift-cross
  28   (:use #:common-lisp #:fiasco)
  29   (:export #:cross-test))
  30
  31 (in-package #:thrift-cross)
  32
  33 (defparameter *prot* nil)
  34
  35 (load (merge-pathnames "tests.lisp" *load-truename*) :external-format :UTF-8)
  36
  37 (clon:defsynopsis ()
  38   (text :contents "The Common Lisp client for Thrift's cross-language test suite.")
  39   (group (:header "Allowed options:")
  40     (flag :short-name "h" :long-name "help"
  41           :description "Print this help and exit.")
  42     (stropt :long-name "host"
  43             :description "The host to connect to."
  44             :default-value "localhost"
  45             :argument-name "ARG")
  46     (stropt :long-name "port"
  47             :description "Number of the port to listen for connections on."
  48             :default-value "9090"
  49             :argument-name "ARG"
  50             :argument-type :optional)
  51     (stropt :long-name "transport"
  52             :description "Transport: transport to use (\"buffered\", \"framed\")"
  53             :default-value "buffered"
  54             :argument-name "ARG")
  55     (stropt :long-name "protocol"
  56             :description "Protocol: protocol to use (\"binary\", \"multi\")"
  57             :default-value "binary"
  58             :argument-name "ARG")))
  59
  60 (defun main ()
  61   "Entry point for our standalone application."
  62   (clon:make-context)
  63   (when (clon:getopt :short-name "h")
  64     (clon:help)
  65     (clon:exit))
  66   (let ((port "9090")
  67         (host "localhost")
  68         (framed nil)
  69         (multiplexed nil))
  70     (clon:do-cmdline-options (option name value source)
  71       (print (list option name value source))
  72       (if (string= name "host")
  73           (setf host value))
  74       (if (string= name "port")
  75           (setf port value))
  76       (if (string= name "transport")
  77           (cond ((string= value "buffered") (setf framed nil))
  78                 ((string= value "framed") (setf framed t))
  79                 (t (error "Unsupported transport."))))
  80       (if (string= name "protocol")
  81           (cond ((string= value "binary") (setf multiplexed nil))
  82                 ((string= value "multi") (setf multiplexed t))
  83                 (t (error "Unsupported protocol.")))))
  84     (terpri)
  85     (setf *prot* (thrift.implementation::client (puri:parse-uri
  86                                                  (concatenate 'string "thrift://" host ":" port))
  87                                                 :framed framed
  88                                                 :multiplexed multiplexed))
  89     (let ((result (cross-test :multiplexed multiplexed)))
  90       (thrift.implementation::close *prot*)
  91       (clon:exit result))))
  92
  93 (clon:dump "TestClient" main)