Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Added some client side logging when submitting files to the blobstore…

…d (in a separate branch issue8). re #8.
  • Loading branch information...
commit c3583532dcf6ac3896d25192e5c4f31fe00644d8 1 parent 3325c60
@avodonosov avodonosov authored
View
138 gae-blobstore/lisp-client/test-grid-gae-blobstore.lisp
@@ -83,53 +83,99 @@ a warning message, followed by the end of the file."
;; (funcall fun out)
;; fun)))
+;;; Debugging tools
+
+(defun log-dir ()
+ (merge-pathnames "upload-debug-logs/"
+ (asdf:system-source-directory '#:test-grid-blobstore)))
+
+(defun log-file ()
+ (merge-pathnames "upload.log" (log-dir)))
+
+(defun with-log-stream-impl (body-func)
+ (ensure-directories-exist (log-dir))
+ (with-open-file (out (log-file)
+ :direction :output
+ :if-exists :append
+ :if-does-not-exist :create)
+ (funcall body-func out)))
+
+(defmacro with-log-stream ((var) &body body)
+ `(with-log-stream-impl (lambda (,var)
+ ,@body)))
+
+(defparameter *upload-id-random-state* (make-random-state t))
+(defun new-upload-id ()
+ (random 1000000 *upload-id-random-state*))
+
+(defun fmt-log-time (universal-time &optional destination)
+ (multiple-value-bind (sec min hour date month year)
+ (decode-universal-time universal-time 0)
+ (funcall #'format
+ destination
+ "~2,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
+ year month date hour min sec)))
+
+(defun log-time ()
+ (fmt-log-time (get-universal-time)))
+
+;;; end of debugging
+
(defmethod test-grid-blobstore:submit-files ((blobstore blobstore) id-pathname-alist)
- (let* (;; Google App Engine does not allow to submit blobs to a constant URL,
- ;; we need to perform a separate request to our servlet, which will
- ;; generate an URL where we can upload files.
- (upload-url (drakma:http-request (format nil "~A/upload-url" (base-url blobstore))
- :content-type "text/text"))
-
- ;; Now prepare POST parameters for the main submit request,
- ;; according the drakma API for file posting.
- ;;
- ;; Namely, ensure the IDs are strings and add "text/plain" content type.
- ;;
- ;; Example: if ID-PATHNAME-ALIST is
- ;; ((:alexandria #P"/logs/alexandria.log") ... )
- ;; convert it to
- ;; (("alexandria" #P"/logs/alexandria.log" :content-type "text/plain") ... )
- (post-params (mapcar #'(lambda (elem)
- (cons (string-downcase (car elem))
- (list (limit-file-length (cdr elem))
- :filename (file-namestring (cdr elem))
- :content-type "text/plain")))
- id-pathname-alist))
- ;; Perrorm the query.
- (response (with-open-stream (in (drakma:http-request upload-url
- :method :post
- :content-length t
- :parameters post-params
- :want-stream t))
- ;; And read the response
- (safe-read in))))
- ;; Now RESPONSE contains an alist of
- ;; (<stringified ID> . <blob key>) pairs.
- ;; For example:
- ;; (("alexandria" . "cJVA1Klp7o-Lz2Cc6KuPcg") ...)
- ;; As in the original id-pathname-alist the IDs might be represented
- ;; as symbols, lets return response with IDs in the original form, e.g.
- ;; ((:alexandria . "cJVA1Klp7o-Lz2Cc6KuPcg") ...)
- ;;
- ;; During the conversion we also check that we got blobkeys for
- ;; all the files we submitted.
- (flet ((get-blobkey (for-id)
- (or (cdr (assoc for-id response :test #'string-equal))
- (error "The response does not contain a blobkey for the ~A" for-id))))
- (mapcar (lambda (id-pathname-pair)
- (cons (car id-pathname-pair)
- (get-blobkey (car id-pathname-pair))))
- id-pathname-alist))))
+ (with-log-stream (lg)
+ (let ((drakma:*header-stream* lg))
+ (format lg "~A ->test-grid-blobstore:submit-files~%" (log-time))
+ (let* ( ;; Google App Engine does not allow to submit blobs to a constant URL,
+ ;; we need to perform a separate request to our servlet, which will
+ ;; generate an URL where we can upload files.
+ (upload-url (drakma:http-request (format nil "~A/upload-url" (base-url blobstore))
+ :content-type "text/text"))
+ ;; Now prepare POST parameters for the main submit request,
+ ;; according the drakma API for file posting.
+ ;;
+ ;; Namely, ensure the IDs are strings and add "text/plain" content type.
+ ;;
+ ;; Example: if ID-PATHNAME-ALIST is
+ ;; ((:alexandria #P"/logs/alexandria.log") ... )
+ ;; convert it to
+ ;; (("alexandria" #P"/logs/alexandria.log" :content-type "text/plain") ... )
+ (post-params (progn
+ (format lg "~A upload-url: ~A~%" (log-time) upload-url)
+ (mapcar #'(lambda (elem)
+ (cons (string-downcase (car elem))
+ (list (limit-file-length (cdr elem))
+ :filename (file-namestring (cdr elem))
+ :content-type "text/plain")))
+ id-pathname-alist)))
+ ;; Perrorm the query.
+ (response (with-open-stream (in (drakma:http-request upload-url
+ :method :post
+ :content-length t
+ :parameters post-params
+ :want-stream t))
+ ;; And read the response
+ (safe-read in))))
+ (format lg "~A response received from blobstore: ~S~%" (log-time) response)
+ ;; Now RESPONSE contains an alist of
+ ;; (<stringified ID> . <blob key>) pairs.
+ ;; For example:
+ ;; (("alexandria" . "cJVA1Klp7o-Lz2Cc6KuPcg") ...)
+ ;; As in the original id-pathname-alist the IDs might be represented
+ ;; as symbols, lets return response with IDs in the original form, e.g.
+ ;; ((:alexandria . "cJVA1Klp7o-Lz2Cc6KuPcg") ...)
+ ;;
+ ;; During the conversion we also check that we got blobkeys for
+ ;; all the files we submitted.
+ (let ((result
+ (flet ((get-blobkey (for-id)
+ (or (cdr (assoc for-id response :test #'string-equal))
+ (error "The response does not contain a blobkey for the ~A" for-id))))
+ (mapcar (lambda (id-pathname-pair)
+ (cons (car id-pathname-pair)
+ (get-blobkey (car id-pathname-pair))))
+ id-pathname-alist))))
+ (format lg "~A <-test-grid-blobstore:submit-files: ~S~%" (log-time) result)
+ result)))))
(defmethod test-grid-blobstore:submit-run-info ((blobstore blobstore) run-info)
(assert (not (null run-info)))
View
4 submit-last-day-results.lisp
@@ -39,8 +39,8 @@ has a blobstore key for the library log."
(dolist (test-dir (cl-fad:list-directory (test-grid::test-output-base-dir)))
(let ((dir-name (file-namestring (cl-fad:pathname-as-file test-dir))))
- (when (and (string> dir-name hour-ago-str)
- (not (submitted-p test-dir)))
+ (when t ;(and (string> dir-name hour-ago-str)
+ ; (not (submitted-p test-dir)))
(format t "submitting ~A~%" test-dir)
(test-grid::submit-results test-dir)
(incf submit-count))))
View
6 test-grid.lisp
@@ -1123,9 +1123,9 @@ data (libraries test suites output and the run results) will be saved."
(defun submit-results (test-run-dir)
(let* ((blobstore (get-blobstore))
(run-info (submit-logs blobstore test-run-dir)))
- (format t "The log files are submitted. Submitting the test run info...~%")
- (test-grid-blobstore:submit-run-info blobstore run-info)
- (format t "Done. The test results are submitted. They will be reviewed by admin soon and added to the central database.~%")
+ (format t "The log files are submitted; (not submitting test-run-info.lisp in this version - dubugging for issue #8).~%")
+;; (test-grid-blobstore:submit-run-info blobstore run-info)
+;; (format t "Done. The test results are submitted. They will be reviewed by admin soon and added to the central database.~%")
run-info))
(defun run-libtests (&optional (libs *all-libs*))
Please sign in to comment.
Something went wrong with that request. Please try again.