Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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
Anton Vodonosov avodonosov authored
138 gae-blobstore/lisp-client/test-grid-gae-blobstore.lisp
View
@@ -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)))
4 submit-last-day-results.lisp
View
@@ -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))))
6 test-grid.lisp
View
@@ -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.