#lang racket/base
(require racket/runtime-path
racket/cmdline
racket/port
racket/file
racket/list
web-server/servlet
web-server/servlet-env
xml
"logger.ss"
"../../compile-helpers.ss"
(prefix-in lap: "../local-android-packager.ss")
(planet dyoo/pack-directory:1/pack-directory))
(define-runtime-path HTDOCS-PATH "htdocs")
(define current-access-logger (make-parameter #f))
(define (start req)
(with-handlers ([exn:fail?
(lambda (exn)
(handle-unexpected-error exn))])
(let-values ([(metadata asset-zip-bytes)
(parse-request req)])
(write-to-access-log! req asset-zip-bytes)
(let ([tmpdir
(make-temporary-file "mztmp~a" 'directory #f)])
(dynamic-wind (lambda ()
(void))
(lambda ()
(cond
[(and metadata asset-zip-bytes)
(lap:prepare-android-package-src-structure
(metadata-name metadata)
(metadata-permissions metadata)
tmpdir)
(lap:write-local.properties tmpdir)
(parameterize ([current-directory
(build-path tmpdir "assets")])
(unpack-into-current-directory asset-zip-bytes
#:exists 'replace))
(run-ant-build.xml tmpdir "debug")
(let ([apk-bytes (lap:get-apk-in-dest tmpdir)])
(make-package-response metadata
apk-bytes))]
[else
(error-no-program)]))
(lambda ()
(delete-directory/files tmpdir)))))))
(define (write-to-access-log! req program/resources)
(void)
(when (current-access-logger)
(with-handlers ([void (lambda (exn)
(write (exn-message exn) (current-error-port)))])
(logger-add! (current-access-logger)
(request-client-ip req)
program/resources
'()))))
(define (parse-request req)
(let ([post-bytes (request-post-data/raw req)])
(cond
[post-bytes
(let ([ip (open-input-bytes post-bytes)]
[op (open-output-bytes)])
(let ([metadata (read ip)])
(copy-port ip op)
(values metadata (get-output-bytes op))))]
[else
(values #f #f)])))
(define (make-package-response metadata package-bytes)
(make-response/full
200
#"OK"(current-seconds)
#"application/vnd.android.package-archive"
(list (make-header #"content-disposition"
(string->bytes/utf-8
(format "attachment; filename=~a.apk"
(normalize-name-as-filename
(metadata-name metadata))))))
(list package-bytes)))
(define (metadata-name a-metadata)
(second (assoc 'name a-metadata)))
(define (metadata-permissions a-metadata)
(second (assoc 'permissions a-metadata)))
(define (normalize-name-as-filename a-name)
(let ([a-name
(regexp-replace* #px"[^\\w]" a-name "")])
(cond
[(string=? a-name "")
"program"]
[else
a-name])))
(define (error-no-program)
(make-response/full
400
#"Bad Request"
(current-seconds)
#"text/html"
(list)
(list (string->bytes/utf-8
(xexpr->string
`(html (head (title error))
(body
"The expected program is missing from the request.")))))))
(define (handle-unexpected-error exn)
(make-response/full
400
#"Bad Request"
(current-seconds)
#"text/html"
(list)
(list (string->bytes/utf-8
(xexpr->string
`(html (head (title error))
(body
"Moby was unable to build your program due to an unexpected error.\n"
(br)
"Please contact the Moby developers, and include the following content:\n"
(br)
,(exn-message exn))))))))
(define PORT (make-parameter 8888))
(define LOGFILE-PATH (make-parameter (build-path (current-directory) "access.log")))
(command-line #:once-each
[("-p" "--port") port "Use port for web server"
(PORT (string->number port))]
[("-L" "--logfile-dir") logfile-dir "Use the directory to write access.log"
(LOGFILE-PATH (build-path logfile-dir "access.log"))])
(current-access-logger (make-logger (LOGFILE-PATH)))
(serve/servlet start
#:launch-browser? #f
#:quit? #f
#:listen-ip #f
#:port (PORT)
#:extra-files-paths (list HTDOCS-PATH)
#:servlet-regexp (regexp "^/package$"))