Initial implementation of efax egg

4 files changed, 186 insertions, 0 deletions

diff --git a/efax.meta b/efax.meta
new file mode 100644
index 0000000..5e81b7d
--- /dev/null
+++ b/efax.meta
@@ -0,0 +1,10 @@
+;;; efax.meta -*- Scheme -*-
+
+((egg "efax")
+ (synopsis "Library for using the eFax service for sending faxes over the internet")
+ (category misc)
+ (author "Peter Bex")
+ (doc-from-wiki)
+ (license "BSD")
+ (depends (http-client "0.5") uri-common base64 sxml-serializer ssax sxpath)
+ (files "efax.setup" "efax.scm" "efax.release-info" "efax.meta"))
\ No newline at end of file
diff --git a/efax.release-info b/efax.release-info
new file mode 100644
index 0000000..2a84311
--- /dev/null
+++ b/efax.release-info
@@ -0,0 +1,2 @@
+(repo hg "https://bitbucket.org/sjamaan/{egg-name}")
+(uri targz "https://bitbucket.org/sjamaan/{egg-name}/get/{egg-release}.tar.gz")
diff --git a/efax.scm b/efax.scm
new file mode 100644
index 0000000..de7a451
--- /dev/null
+++ b/efax.scm
@@ -0,0 +1,171 @@
+(module efax
+  (efax-password efax-username efax-account efax-send efax-status)
+
+(import chicken scheme)
+
+(use srfi-1 srfi-13 data-structures
+     uri-common http-client base64 sxml-serializer ssax sxpath)
+
+(define efax-service-uri "https://secure.efaxdeveloper.com/EFax_WebFax.serv")
+
+(define efax-account  (make-parameter #f))
+(define efax-username (make-parameter #f))
+(define efax-password (make-parameter #f))
+
+(define-syntax let-auth
+  (syntax-rules ()
+    ((_ ?procname ?account ?username ?password ?body ...)
+     (let ((?username (or (and ?password ?username) (efax-username)))
+           (?password (or (and ?username ?password) (efax-password)))
+           ;; Account can be provided separately via the global param,
+           ;; but username and password must be provided at the same place.
+           (?account  (or ?account (efax-account))))
+       (unless (and ?username ?password ?account)
+         (error '?procname
+                (conc "You must provide an eFax account, username & password, "
+                      "either via the efax-account, efax-username and "
+                      "efax-password global parameters or via the account, "
+                      "username and password keys for this procedure")))
+       ?body ...))))
+
+(define (read-document-or-raise-error port location)
+  (let* ((result (ssax:xml->sxml port '()))
+         (tid ((if-car-sxpath
+                '(// TransmissionControl TransmissionID *text*)) result))
+         (did ((if-car-sxpath
+                '(// TransmissionControl DOCID *text*)) result))
+         (code ((if-car-sxpath '(// Response StatusCode *text*)) result)))
+    (if (or (not code) (string=? code "1"))
+        result
+        (signal (make-composite-condition
+                 (make-property-condition
+                  'exn
+                  'location location
+                  'message
+                  ((if-car-sxpath '(// Response ErrorMessage *text*))
+                   result))
+                 (make-property-condition
+                  'efax
+                  'error-code code
+                  'error-description
+                  ((sxpath '(// Response StatusDescription)) result)
+                  'error-level
+                  (string->symbol
+                   (string-downcase
+                    ((if-car-sxpath '(// Response ErrorLevel *text*)) result)))
+                  'document-id did 'transmission-id tid))))))
+
+;; TODO: This should probably allow files to be ports so that we can
+;; stream large amounts of data. That would mean we can't use SXML anymore,
+;; though!  Instead, we would need some kind of chunked layer-upon-layer
+;; procedure that encodes base64 inside XML inside uri-encoded POST data.
+;; It's probably not worth it since it isn't likely people are going to
+;; send gigabytes worth of data; it has to come out a fax machine, which
+;; would translate to many pages of dead tree!
+(define (efax-send recipients files
+                   #!key account username password transmission-id
+                   unique-id customer-id high-resolution high-priority)
+  (let-auth efax-send account username password
+    (call-with-input-request
+     efax-service-uri
+     `((id . ,account)
+       (respond . "XML")
+       (xml . ,(serialize-sxml
+                `(*TOP*
+                  (*PI* xml "version=\"1.0\"")
+                  (OutboundRequest
+                   (AccessControl (UserName ,username) (Password ,password))
+                   (Transmission
+                    (TransmissionControl
+                     ;; TODO: SelfBusy, FaxHeader
+                     ,@(if transmission-id `((TransmissionID ,transmission-id)) '())
+                     (NoDuplicates ,(if unique-id "ENABLE" "DISABLE"))
+                     ,@(if customer-id `((CustomerID ,customer-id)) '())
+                     (Resolution ,(if high-resolution "FINE" "STANDARD"))
+                     (Priority ,(if high-priority "HIGH" "NORMAL")))
+                    (DispositionControl
+                     ;; TODO: DispositionURL, DispositionLevel, DispositionMethod, DispositionEmail(s)?
+                     (DispositionLevel "NONE"))
+                    (Recipients
+                     . ,(if (string? recipients)
+                            `((Recipient (RecipientFax ,recipients)))
+                            (map
+                             (lambda (recipient)
+                               `(if (string? recipient)
+                                    `(Recipient (RecipientFax ,recipient))
+                                    `(Recipient
+                                      ,@(map
+                                         (lambda (entry)
+                                           (let ((key (car entry))
+                                                 (value (cdr entry)))
+                                             (case key
+                                               ((name) `(RecipientName ,value))
+                                               ((company) `(RecipientName ,value))
+                                               ((fax) `(RecipientFax ,value))
+                                               (else (error "Unknown recipient key" key)))))
+                                         recipient))))
+                             recipients)))
+                    (Files . ,(map (lambda (file)
+                                     `(File (FileContents ,(base64-encode (cdr file)))
+                                            (FileType ,(->string (car file)))))
+                                   files))))))))
+     (lambda (port)
+       (let* ((doc (read-document-or-raise-error port 'efax-send))
+              (tid ((if-car-sxpath
+                     '(// TransmissionControl TransmissionID *text*)) doc))
+              (did ((if-car-sxpath
+                     '(// TransmissionControl DOCID *text*)) doc)))
+         `((doc-id . ,did) (transmission-id . ,tid)))))))
+
+(define (efax-status #!key account username password doc-id transmission-id)
+  (let-auth efax-status account username password
+    (call-with-input-request
+     efax-service-uri
+     `((id . ,account)
+       (respond . "XML")
+       (xml . ,(serialize-sxml
+                `(*TOP*
+                  (*PI* xml "version=\"1.0\"")
+                  (OutboundStatus
+                   (AccessControl (UserName ,username) (Password ,password))
+                   (Transmission
+                    (TransmissionControl
+                     ,@(if transmission-id `((TransmissionID ,transmission-id)) '())
+                     ,@(if doc-id `((DOCID ,doc-id)) '()))))))))
+     (lambda (port)
+       (let* ((doc (read-document-or-raise-error port 'efax-status))
+              (tid ((if-car-sxpath
+                     '(// TransmissionControl TransmissionID *text*)) doc)))
+         `((transmission-id . ,tid)
+           (recipients . ,(map (lambda (r)
+                                 (cons
+                                  ((if-car-sxpath '(Fax *text*)) r)
+                                  (fold-right
+                                   (lambda (name expr result)
+                                     (let ((value ((if-car-sxpath expr) r)))
+                                       (if value
+                                           (cons (cons name value) result)
+                                           result)))
+                                   '()
+                                   '(name company fax status-message
+                                     status-classification status-outcome
+                                     last-attempt-date last-attempt-time
+                                     next-attempt-date next-attempt-time
+                                     pages-scheduled pages-sent
+                                     baud-rate retries remote-csid)
+                                   '((Name *text*) (Company *text*) (Fax *text*)
+                                     (Status Message *text*)
+                                     (Status Outcome *text*)
+                                     (Status Classification *text*)
+                                     (LastAttempt LastDate *text*)
+                                     (LastAttempt LastTime *text*)
+                                     (NextAttempt NextDate *text*)
+                                     (NextAttempt NextTime *text*)
+                                     (Pages Scheduled *text*)
+                                     (Pages Sent *text*)
+                                     (BaudRate *text*)
+                                     (Retries *text*)
+                                     (RemoteCSID *text*)))))
+                           ((sxpath '(// Recipient)) doc)))))))))
+
+)
\ No newline at end of file
diff --git a/efax.setup b/efax.setup
new file mode 100644
index 0000000..102e143
--- /dev/null
+++ b/efax.setup
@@ -0,0 +1,3 @@
+;;; efax.setup -*- Scheme -*-
+
+(standard-extension 'efax "0.1")
\ No newline at end of file