Skip to content
Browse files

Send email notifications through the Heroku server.

  • Loading branch information...
1 parent 69542c5 commit c7eb767f01fbf954db3857dd9c83b03832f033b3 @avodonosov avodonosov committed Feb 14, 2013
Showing with 57 additions and 31 deletions.
  1. +6 −22 agent/agent.lisp
  2. +28 −0 agent/send-notification.lisp
  3. +19 −8 agent/submit-results.lisp
  4. +4 −1 test-grid-agent.asd
View
28 agent/agent.lisp
@@ -18,13 +18,10 @@
;;; Agent implementation class
(defclass agent-impl (agent)
((persistence :type persistence :accessor persistence)
- (results-receiver :type (function (list lisp-exe)) ; function of two arguments - test run and the lisp-exe produced it
- :accessor results-receiver)
(result-storage-name :type string
:accessor result-storage-name
:initarg :result-storage-name
:initform "main")
- (blobstore :accessor blobstore :initform (make-gae-blobstore))
(project-lister :type project-lister :accessor project-lister)
;; custom-lib-world may be a plist in the form
;; (:directory <pathname designator> :id <string>)
@@ -60,23 +57,11 @@
;;; --- end of lisp specifications handling ---
(defmethod initialize-instance :after ((agent agent-impl) &key)
- (setf (work-dir agent) (default-work-dir)
- (results-receiver agent) (lambda (test-run lisp-exe)
- (dolist (storage (result-storages-for-lisp agent lisp-exe))
- (test-grid-storage:add-test-run storage test-run))
- ;; temporary keep submitting via the old chanell too, just for sure
- (tg-gae-blobstore:submit-run-info (blobstore agent)
- test-run))))
+ (setf (work-dir agent) (default-work-dir)))
(defmethod make-agent ()
(make-instance 'agent-impl))
-(defun make-gae-blobstore ()
- (test-grid-gae-blobstore:make-blob-store :base-url
- ;; during development of GAE blob storage
- ;; :base-url may be "http://localhost:8080"
- "http://cl-test-grid.appspot.com"))
-
;;; Working directory structure
(defun test-output-base-dir (agent)
(merge-pathnames "test-runs/" (work-dir agent)))
@@ -277,7 +262,7 @@ the PREDICATE."
agent
lisp
(project-names (project-lister agent)))))
- (submit-test-run-results agent results-dir lisp)
+ (submit-test-run-results results-dir (result-storages-for-lisp agent lisp))
(mark-tested (persistence agent) lib-world (implementation-identifier lisp))
(cl-fad:delete-directory-and-files results-dir :if-does-not-exist :ignore)))
continue)))))
@@ -294,11 +279,10 @@ the PREDICATE."
(defun send-hello-notification (agent)
(log:info "sending hello notification")
- (tg-gae-blobstore:send-notification (blobstore agent)
- (format nil "[agent hello] from ~A (~A)"
- (get-agent-id (persistence agent))
- (user-email agent))
- "hello"))
+ (send-notification (format nil "[agent hello] from ~A (~A)"
+ (get-agent-id (persistence agent))
+ (user-email agent))
+ "hello"))
(defmethod main (agent)
;; setup logging for unhandled errors and warnings
View
28 agent/send-notification.lisp
@@ -0,0 +1,28 @@
+;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*-
+;;;; Copyright (C) 2011 Anton Vodonosov (avodonosov@yandex.ru)
+;;;; See LICENSE for details.
+
+;;;; Utility to send notifications to the cl-test-grid-notifications google group:
+;;;; https://groups.google.com/forum/?fromgroups=#!forum/cl-test-grid-notifications.
+;;;; The messages are send via our Heroku server. That way agent remains
+;;;; communicating only via HTTP, and is also restricted to send emails
+;;;; only to that particular email adress.
+
+(in-package #:test-grid-agent)
+
+(defun send-notification (subject body &key (server-url "http://cl-test-grid.herokuapp.com/"))
+ (handler-case
+ (multiple-value-bind (body status)
+ (drakma:http-request (format nil "~a/send-notification" server-url)
+ :method :get
+ :parameters (list (cons "subject" subject)
+ (cons "body" body)))
+ (declare (ignore body))
+ (when (/= 200 status)
+ (error "Notificateion server returned error HTTP status ~A" status)))
+ (serious-condition (c)
+ (warn "Failed do send notification due to ~A: ~A" (type-of c) c))))
+
+#|
+(send-notification "test, please ignore" "test body")
+|#
View
27 agent/submit-results.lisp
@@ -49,14 +49,6 @@
(save-run-info run-info test-run-dir)
run-info))
-(defun submit-test-run-results (agent test-run-dir lisp-exe)
- (log:info "Submitting the test results to the server from the directory ~S ..." (truename test-run-dir))
- (let* ((run-info (submit-logs (blobstore agent) test-run-dir)))
- (log:info "The log files are submitted. Submitting the test run info...")
- (funcall (results-receiver agent) run-info lisp-exe)
- (log:info "Done. The test results are submitted.")
- run-info))
-
(defun submitted-p (test-run)
"Tests whether the specified TEST-RUN is already
submitetd by checking if it contains a blobstore key
@@ -66,6 +58,25 @@ for some log."
(let ((load-result (first (getf lib-result :load-results))))
(getf load-result :log-blob-key)))))
+(defun make-gae-blobstore ()
+ (test-grid-gae-blobstore:make-blob-store :base-url
+ ;; during development of GAE blob storage
+ ;; :base-url may be "http://localhost:8080"
+ "http://cl-test-grid.appspot.com"))
+
+(defun submit-test-run-results (test-run-dir storage-names)
+ (log:info "Submitting the test results to the server from the directory ~S ..." (truename test-run-dir))
+ (let* ((blobstore (make-gae-blobstore))
+ (run-info (submit-logs blobstore test-run-dir)))
+ (log:info "The log files are submitted. Submitting the test run info...")
+ (dolist (storage storage-names)
+ (test-grid-storage:add-test-run storage run-info))
+ (send-notification (format nil "[test run submitted] [storages: ~{~A~^, ~}]"
+ storage-names)
+ (format nil "~S" (tg-data::run-descr run-info)))
+ (log:info "Done. The test results are submitted.")
+ run-info))
+
(defun list-test-runs (test-runs-root-dir)
(let ((test-runs '()))
(dolist (child (cl-fad:list-directory test-runs-root-dir))
View
5 test-grid-agent.asd
@@ -24,7 +24,9 @@
#:fare-memoization
#:usocket
#:trivial-backtrace
- #:trivial-features)
+ #:trivial-features
+ #:drakma
+ #:flexi-streams)
:components
((:module "agent"
:serial t
@@ -40,5 +42,6 @@
(:file "as-singleton-agent")
(:file "generate-id")
(:file "project-lister")
+ (:file "send-notification")
(:file "agent")
(:file "api-compatible-p")))))

0 comments on commit c7eb767

Please sign in to comment.
Something went wrong with that request. Please try again.