From 9aa1c5eeffa0320b2eae82cae55223d7362ce9f6 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Wed, 6 Jul 2011 21:40:56 +0200 Subject: Initial implementation of efax egg --- efax.meta | 10 ++++ efax.release-info | 2 + efax.scm | 171 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ efax.setup | 3 + 4 files changed, 186 insertions(+) create mode 100644 efax.meta create mode 100644 efax.release-info create mode 100644 efax.scm create mode 100644 efax.setup 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 -- cgit v1.2.3