;; -*- mode: common-lisp; package: user -*- ;; ;; copyright (c) 2003 Franz Inc, Berkeley, CA ;; ;; The software, data and information contained herein are proprietary ;; to, and comprise valuable trade secrets of, Franz, Inc. They are ;; given in confidence by Franz, Inc. pursuant to a written license ;; agreement, and may be stored and used only in accordance with the terms ;; of such license. ;; ;; Restricted Rights Legend ;; ------------------------ ;; Use, duplication, and disclosure of the software, data and information ;; contained herein by any agency, department or entity of the U.S. ;; Government are subject to restrictions of Restricted Rights for ;; Commercial Software developed at private expense as specified in ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable. ;; $Id: soapex.lisp,v 1.1 2005/06/08 09:05:22 paul Exp $ ;; SOAP server example ;; This example may be submitted to the SOAP validator at http://www.soapware.org/ (in-package :user) (eval-when (compile load eval) (require :soap)) (defpackage :user (:use :net.xmp.soap)) (defpackage :net.xmp.schema (:use) (:nicknames :xs :xsd)) (defpackage :net.xmp.schema-instance (:use) (:nicknames :xsi)) (defpackage :net.xmp.soap.none (:use) (:nicknames :none)) (defpackage :net.xmp.soap.envelope (:use) (:nicknames :env)) (defpackage :net.xmp.soap.encoding (:use) (:nicknames :enc)) ;;; ;;; The validation page is at: http://validator.soapware.org/ ;;; ;;; 1. Sart the Lisp server ;;; 2. Go to the validation page ;;; 3. Enter the host, port and path information for the server ;;; 4. Wait for the results ;;; ;;; Top level functions: ;;; ;;; make-validator1-server &optional port ;;; try-validator1 &key index port host path #+test (make-validator1-server 8890) #+test (print (try-validator1 :port 8890)) (define-soap-element nil "countTheEntities" '(:complex (:seq (:element "s" enc:|string|)))) (define-soap-element nil "countTheEntitiesResponse" '(:complex (:seq (:element "struct" (:complex (:seq (:element "ctLeftAngleBrackets" enc:|int|) (:element "ctRightAngleBrackets" enc:|int|) (:element "ctAmpersands" enc:|int|) (:element "ctApostrophes" enc:|int|) (:element "ctQuotes" enc:|int|) )))))) (define-soap-element nil "easyStructTest" '(:complex (:seq (:element "stooges" (:complex (:set (:element "moe" enc:|int|) (:element "larry" enc:|int|) (:element "curly" enc:|int|))))))) (define-soap-element nil "easyStructTestResult" '(:complex (:seq (:element "number" (:simple enc:|int|))))) (define-soap-element nil :|myStruct| '(:complex (:seq* (:element nil (:complex (:seq* (:any))))))) (define-soap-element nil "echoStructTest" '(:complex (:seq :|myStruct|))) (define-soap-element nil "echoStructTestResult" '(:complex (:seq :|myStruct|))) (define-soap-element nil "manyTypesTest" '(:complex (:seq (:element "num" xsd:|int|) (:element "bool" xsd:|boolean|) (:element "state" xsd:|string|) (:element "doub" xsd:|float|) (:element "dat" xsd:|string|) (:element "bin" xsd:|string|)))) (define-soap-element nil "manyTypesTestResult" '(:complex (:seq (:element "Result" (:array xsd:|ur-type| :array-item (:element "item" :send-type t :argument :type-and-arg) :send-type enc:|Array| :send-atype xsd:|ur-type| :send-asize t ) )))) (define-soap-element nil "moderateSizeArrayCheck" '(:complex (:seq (:element "myArray" (:array xsd:|string|))))) (define-soap-element nil "moderateSizeArrayCheckResult" '(:complex (:seq (:element "result" (:simple enc:|string|))))) (define-soap-element nil "nestedStructTest" '(:complex (:seq (:element :|myStruct| (:complex (:seq* (:element ("year2000" "year2001" "year2002") (:complex (:seq* (:element ("month01" "month02" "month03" "month04") (:complex (:seq* (:element ("day01" "day02" "day03" "day04" "day05" "day06" "day07" "day08" "day09" "day10" "day11" "day12" "day13" "day14" "day15" "day16" "day17" "day18" "day19" "day20" "day21" "day22" "day23" "day24" "day25" "day26" "day27" "day28" "day29" "day30" "day31" ) (:complex (:set (:element "moe" enc:|int|) (:element "larry" enc:|int|) (:element "curly" enc:|int|) ))))))))))))))) (define-soap-element nil "nestedStructTestResult" '(:complex (:seq (:element "result" (:simple enc:|int|))))) (define-soap-element nil "simpleStructReturnTest" '(:complex (:seq (:element "myNumber" (:simple enc:|int|))))) (define-soap-element nil "simpleStructReturnTestResult" '(:complex (:seq (:element "struct" (:complex (:seq (:element "times10" enc:|int|) (:element "times100" enc:|int|) (:element "times1000" enc:|int|))))))) (define-soap-element nil "whichToolkit" '(:complex (:seq))) (define-soap-element nil "whichToolkitResult" '(:complex (:seq (:element "struct" (:complex (:seq (:element "toolkitDocsUrl" enc:|string|) (:element "toolkitName" enc:|string|) (:element "toolkitVersion" enc:|string|) (:element "toolkitOperatingSystem" enc:|string|))))))) (defvar *validator1-dns* (list nil (list :net.xmp.soap.envelope "SOAP-ENV" "http://schemas.xmlsoap.org/soap/envelope/") (list :net.xmp.soap.encoding "SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/") (list :net.xmp.schema "xsd" "http://www.w3.org/1999/XMLSchema") (list :net.xmp.schema-instance "xsi" "http://www.w3.org/1999/XMLSchema-instance") )) (defparameter *validator1-path* "/validator1") (defun make-validator1-server (&optional (port 8080)) (let ((s (soap-message-server :start (list :port port) :enable :start :publish (list :path *validator1-path*) :action :none :lisp-package :keyword :message-dns *validator1-dns* ))) (soap-export-method s "countTheEntities" (list "s") :lisp-name 'validator1-count :return "countTheEntitiesResponse") (soap-export-method s "easyStructTest" (list "stooges") :lisp-name 'validator1-easy-struct :return "easyStructTestResult") (soap-export-method s "echoStructTest" (list :|myStruct|) :lisp-name 'validator1-echo-struct :return "echoStructTestResult") (soap-export-method s "manyTypesTest" (list "num" "bool" "state" "doub" "dat" "bin") :lisp-name 'validator1-many-types :return "manyTypesTestResult") (soap-export-method s "moderateSizeArrayCheck" (list "myArray") :lisp-name 'validator1-array-check :return "moderateSizeArrayCheckResult") (soap-export-method s "nestedStructTest" (list :|myStruct|) :lisp-name 'validator1-nested-struct :return "nestedStructTestResult") (soap-export-method s "simpleStructReturnTest" (list "myNumber") :lisp-name 'validator1-struct-return :return "simpleStructReturnTestResult") (soap-export-method s "whichToolkit" () :lisp-name 'validator1-toolkit :return "whichToolkitResult") s)) (defun try-validator1 (&key index (port 8080) (host "localhost") (path *validator1-path*)) ;; this function is to test that the server is responding locally (let ((client (soap-message-client :url (format nil "http://~A:~A~A" host port path) :lisp-package :keyword :message-dns *validator1-dns* ))) (flet ((call (this name &rest args) (cond ((null index) (multiple-value-bind (v e) (ignore-errors (multiple-value-list (apply 'call-soap-method client name args))) (if e (list* this name e (format nil "~A" e)) (list* this name v)))) ((eql index this) (apply 'call-soap-method client name args))))) (list client (call 0 "countTheEntities" :|s| "abcd<>&'\"efg") (call 1 "easyStructTest" :|stooges| (list :|moe| 1 :|larry| 2 :|curly| 3)) (call 2 "echoStructTest" :|myStruct| (list :|substruct0| (list :|moe| 1 :|larry| 2 :|curly| 3) :|substruct1| (list :|moe| 11 :|larry| 22 :|curly| 33))) (call 3 "manyTypesTest" :|num| 17 :|bool| t :|state| "a string" :|doub| 4.5 :|dat| 12345 :|bin| "string to encode") (call 4 "moderateSizeArrayCheck" :|myArray| (list "a" "b" "c" "d")) (call 5 "nestedStructTest" :|myStruct| (list :|year2000| (list :|month04| (list :|day01| (list :|moe| 1 :|larry| 2 :|curly| 3))))) (call 6 "simpleStructReturnTest" :|myNumber| 123) (call 7 "whichToolkit") )))) (defun validator1-count (&key |s| &aux (string |s|)) ;; countTheEntities -- returns :struct ;; ;; This handler takes a single parameter, a string, ;; that contains any number of predefined entities, ;; namely <, >, &, ' and ". ;; Your handler must return a struct that contains five fields, all numbers: ;; ctLeftAngleBrackets, ctRightAngleBrackets, ctAmpersands, ctApostrophes, ctQuotes. (list "struct" (list "ctLeftAngleBrackets" (count #\< string) "ctRightAngleBrackets" (count #\> string) "ctAmpersands" (count #\& string) "ctApostrophes" (count #\' string) "ctQuotes" (count #\" string)))) (defun validator1-easy-struct (&key |stooges| &aux item (result 0)) (dolist (key (list :|moe| :|larry| :|curly|) (list "number" result)) (if (setf item (soap-sub-element-content |stooges| key)) (incf result item) (error "did not find element ~S" key)))) (defun validator1-echo-struct (&key |myStruct|) (list :|myStruct| (soap-alist-to-plist |myStruct| t))) (defun validator1-many-types (&key |num| |bool| |state| |doub| |dat| |bin|) (list "Result" (list (list 'xsd:|int| |num|) (list 'xsd:|boolean| |bool|) (list 'xsd:|string| |state|) (list 'xsd:|float| |doub|) (list 'xsd::|timeInstant| |dat|) (list 'xsd:|string| |bin|) ))) (defun validator1-array-check (&key |myArray|) (list "result" (concatenate 'string (aref |myArray| 0) (aref |myArray| (1- (length |myArray|)))))) (defun validator1-nested-struct (&key |myStruct|) (list "result" (let* ((year (assoc :|year2000| |myStruct|)) (april (assoc :|month04| (cdr year))) (day (assoc :|day01| (cdr april))) (moe (second (assoc :|moe| (cdr day)))) (larry (second (assoc :|larry| (cdr day)))) (curly (second (assoc :|curly| (cdr day))))) (+ moe larry curly)))) (defun validator1-struct-return (&key |myNumber|) (list :|struct| (list :|times10| (* 10 |myNumber|) :|times100| (* 100 |myNumber|) :|times1000| (* 1000 |myNumber|)))) (defun validator1-toolkit () (list :|struct| (list :|toolkitDocsUrl| "http://franz.com" :|toolkitName| "Allegro Common Lisp SOAP" :|toolkitVersion| "6.2" :|toolkitOperatingSystem| "Windows and Unix")))