Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

fixes, written doc.rkt

  • Loading branch information...
commit e91eda30ee852af2cfc163a4a856edd61b292eea 1 parent cc97eed
@elblake authored
View
70 doc.rkt
@@ -1,13 +1,75 @@
-#lang racket/base
+#lang at-exp racket/base
;; For legal info, see file "info.rkt".
-(require (planet neil/mcfly))
+(require (planet neil/mcfly)
+ )
(doc (section "Introduction")
- (para "[[...write introduction here...]]"))
+ @para{
+ This is a Racket library for discovering, accessing and invoking
+ UPnP services.
+
+ }
+
+ @margin-note{
+ This UPnP library currently only implements the client side, that
+ is the service consumer.
+
+ }
+
+ )
+
+(doc (section "How it works")
+ @para{
+ First you must initiate a search with @racket[upnp-discovery] which will begin
+ to collect service advertisements via UDP, when you are ready you can
+ search for a UPnP service by service ID or type. Finally you create a
+ "service wrapper" from a UPnP service.
+
+ }
+
+ (RACKETBLOCK0
+ (define d (upnp-discovery))
+ (define s (upnp-search-service-srvid d "urn:upnp-org:serviceId:WANIPConn1"))
+ (define c (upnp-make-service-wrapper s))
+ )
+
+ @para{
+ With the service wrapper, you can create functions that wrap SOAP
+ request calls to the UPnP service:
+ }
+
+ (RACKETBLOCK0
+ (define get-external-ip
+ (c "GetExternalIPAddress" '("NewExternalIPAddress")))
+
+ (define add-port-mapping
+ (c "AddPortMapping" '()
+ "NewRemoteHost" "NewExternalPort" "NewProtocol"
+ "NewInternalPort" "NewInternalClient" "NewEnabled"
+ "NewPortMappingDescription" "NewLeaseDuration"))
+ )
+
+ @para{
+ And then use @racket[(get-external-ip)] to get the external ip, or use
+ @racket[(add-port-mapping ...)] with the parameters.
+ }
+
+ )
+
+(doc (section "Known Issues")
+
+ @para{
+ At this moment, this library seems to work fine to grab an IP address on my
+ personal router :). This library is relatively new, so certain things might
+ not work quite right or might not work at all with different brands of
+ routers, other networking equipment and anything else that might provide UPnP
+ services.
+
+ })
(doc history
- (#:planet 1:0 #:date "2012-11-11"
+ (#:planet 1:0 #:date "2012-11-16"
"Initial release."))
View
4 info.rkt
@@ -14,8 +14,8 @@
(define mcfly-start "doc.rkt")
(define mcfly-files '(defaults
"doc.rkt"
- "src/soap.rkt"
- "src/upnp-client.rkt"))
+ "soap.rkt"
+ "upnp-client.rkt"))
(define mcfly-license "MIT")
(define mcfly-legal
"Copyright (c) 2012 Edward L. Blake
View
15 src/soap.rkt → soap.rkt
@@ -17,7 +17,8 @@
(require racket/match
racket/list
- xml)
+ xml
+ racket/contract)
(provide soap-encode
soap-decode )
@@ -27,6 +28,14 @@
Takes a Xexpr and outputs a string containing a SOAP envelope.
|#
(define (soap-encode body0 [head0 #f] [ns #f] [enc #f])
+ (unless (or (string? body0) (pair? body0))
+ (raise-argument-error 'soap-encode "xexpr? or string?" body0 body0 head0 ns enc))
+ (unless (or (eq? #f head0) (string? head0))
+ (raise-argument-error 'soap-encode "string?" head0 body0 head0 ns enc))
+ (unless (or (eq? #f ns) (string? ns))
+ (raise-argument-error 'soap-encode "string?" ns body0 head0 ns enc))
+ (unless (or (eq? #f enc) (string? enc))
+ (raise-argument-error 'soap-encode "string?" enc body0 head0 ns enc))
(let* ( [n (if (eq? ns #f) "http://www.w3.org/2001/12/soap-envelope" ns)]
[e (if (eq? enc #f) '() `((s:encodingStyle ,enc)))]
[head (if (or (eq? #f head0) (pair? head0)) head0 (list head0))]
@@ -43,6 +52,10 @@
Takes a string containing a SOAP envelope and returns a Xexpr.
|#
(define (soap-decode m [proc-hdlf #f])
+ (unless (string? m)
+ (raise-argument-error 'soap-decode "string?" m m proc-hdlf))
+ (unless (or (eq? #f proc-hdlf) (procedure? proc-hdlf))
+ (raise-argument-error 'soap-decode "procedure?" proc-hdlf m proc-hdlf))
(let*([x (xml->xexpr (document-element (read-xml (open-input-string m))))]
[ns (match (symbol->string (first x))
[[regexp "^(.+):Envelope$" (list _ a)] a]
View
9 src/upnp-client.rkt → upnp-client.rkt
@@ -28,7 +28,8 @@
racket/port
net/url
xml
- "soap.rkt")
+ "soap.rkt"
+ )
(provide upnp-discovery
upnp-discovery-stop
@@ -314,7 +315,7 @@
(let ([srx (regexp (string-append svu "$"))])
(upnp-search-service-proc
d (λ (location devtype srvtype srvid udn frdname scpdurl ctlurl evturl prsurl mfg mfgurl mfgdesc mdlname)
- (printf "~s ?= ~s -> ~s~n" srx srvid (regexp-match srx srvid))
+ ;(printf "~s ?= ~s -> ~s~n" srx srvid (regexp-match srx srvid))
(if (regexp-match srx srvid)
#t
#f ))
@@ -367,7 +368,7 @@
"Connection: close"
"Accept: text/html, text/xml; q=.2, */*; q=.2"
"Content-type: application/x-www-form-urlencoded")]
- [vam (let () (write (url->string abs*scpdurl)))]
+ ;[_tmp (let () (printf "~s" (url->string abs*scpdurl)))]
[inp (get-pure-port abs*scpdurl hdrs)]
[d (xml->xexpr (document-element (read-xml inp)))]
[hshact (make-hash)]
@@ -523,7 +524,7 @@
"Content-Type: text/xml; charset=\"utf-8\""
,(format "User-Agent: ~a" usragnt))))])
- (printf "Response: ~s\n" fresp)
+ ;(printf "Response: ~s\n" fresp)
(let-values ([(rb rh ns en) (soap-decode fresp handle-fault)])
(let ([respargs (cddr (first rb))]
[argoutset (make-hash)])
Please sign in to comment.
Something went wrong with that request. Please try again.