suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
svn: r3518
This commit is contained in:
Jacob Matthews 2006-06-28 07:17:37 +00:00
parent 343c734291
commit 4cd1207ac1
2 changed files with 81 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/planet/doc.txt
View File

@ -298,6 +298,27 @@ _Distributing Packages with PLaneT_
To put a package on PLaneT, or release an upgrade to an
already-existing package:
0. WRITE YOUR PACKAGE
PLaneT can distribute whatever programs you write, but keep
these guidelines in mind as you write:
i. Organize your code into modules. Since the planet client is
integrated into mzscheme's `require' form, it works best if your code
is arranged into modules.
ii. When one module in your program depends on another, it is best
to require it using the relative-file-name form rather than the
planet require form. For instance, if your program contains files
primary.ss and helper.ss where primary.ss requires helper, use the form
(require "helper.ss")
instead of
(require (planet "helper.ss" ("username" "packagename.plt" 1 0)))
in files that will also be a part of the package.
1. PREPARE A DIRECTORY
Make sure that all source files, documentation, etc. that you want to

29
collects/planet/resolver.ss
View File

@ -360,7 +360,7 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
; then returns a path to it
(define (get-package-from-server pkg)
(with-handlers
([exn:fail? (lambda (e)
(#;[exn:fail? (lambda (e)
(raise (make-exn:fail
(string->immutable-string
(format
@ -410,8 +410,8 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
(current-time))
;; oh man is this a bad hack!
(parameterize ((current-namespace (make-namespace)))
((dynamic-require '(lib "plt-single-installer.ss" "setup") 'install-planet-package)
path the-dir (list owner (pkg-spec-name pkg) extra-path maj min)))))
(let ([ipp (dynamic-require '(lib "plt-single-installer.ss" "setup") 'install-planet-package)])
(ipp path the-dir (list owner (pkg-spec-name pkg) extra-path maj min))))))
(make-pkg (pkg-spec-name pkg) (pkg-spec-path pkg) maj min the-dir)))))
; download-package : FULL-PKG-SPEC -> RESPONSE
@ -505,6 +505,11 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
;; The HTTP protocol does not allow any kind of complicated negotiation, but it appears that
;; many more users can make HTTP requests than requests from nonstandard protocols.
(define (download-package/http pkg)
(let loop ([attempts 1])
(when (> attempts 5)
(raise (make-exn:i/o:protocol
"Download failed too many times (possibly due to an unreliable network connection)"
(current-continuation-marks))))
(let* ((args (pkg->servlet-args pkg))
(target (copy-struct url (string->url (HTTP-DOWNLOAD-SERVLET-URL)) (url-query args)))
@ -523,20 +528,24 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
[(200)
(let ((maj/str (extract-field "Package-Major-Version" head))
(min/str (extract-field "Package-Minor-Version" head))
(content-length (extract-field "Content-Length" head)))
(unless (and maj/str min/str
(content-length/str (extract-field "Content-Length" head)))
(unless (and maj/str min/str content-length/str
(nat? (string->number maj/str))
(nat? (string->number min/str)))
(nat? (string->number min/str))
(nat? (string->number content-length/str)))
(printf "~a" head)
(abort "Server did not include valid major and minor version information"))
(let* ((filename (make-temporary-file "planettmp~a.plt"))
(op (open-output-file filename 'truncate))
(maj (string->number maj/str))
(min (string->number min/str)))
(min (string->number min/str))
(content-length (string->number content-length/str)))
(let ([op (open-output-file filename 'truncate/replace)])
(copy-port ip op)
(close-input-port ip)
(close-output-port op)
(list #t filename maj min)))]
(if (= (file-size filename) content-length)
(list #t filename maj min)
(loop (add1 attempts))))))]
[(404)
(begin0
(list #f (format "Server had no matching package: ~a" (read-line ip)))
@ -552,7 +561,7 @@ attempted to load version ~a.~a while version ~a.~a was already loaded"
[(eof-object? line) '()]
[else (list* line "\n" (loop))]))))))]
[else
(abort (format "Internal error (unknown HTTP response code ~a)" response-code))])))
(abort (format "Internal error (unknown HTTP response code ~a)" response-code))]))))
; ==========================================================================================
; MODULE MANAGEMENT