Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 58 lines (51 sloc) 2.728 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
;;;; -*- 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.

(in-package #:test-grid-agent)

;;; When we run lisp code in an external lisp process,
;;; and want to return some value form that process,
;;; we use a temporary file where the external process
;;; stores the response. We then READ the response
;;; from that file.
;;;
;;; The WITH-RESPONSE-FILE macro generates temporary
;;; file name, executes BODY, and tries to read
;;; an object from the temporary file, and
;;; returns the object read.
;;;
;;; In case of problem reading the response (e.g.
;;; the temporary file is absent after the BODY
;;; execution), the NO-RESPONSE error condition
;;; is signalled.

(define-condition caused-condition (condition)
  ((cause :accessor cause
          :type (or null condition)
          :initarg :cause
          :initform nil))
  (:documentation "A mixin condition class to allow condition
chaining - when signalling a condition we may specify another
condition caused the situation. This way user has
more complete picture about the problem. (Similar to
java.lang.Throwable#getCause in Java)"))

(define-condition no-response (caused-condition simple-error)
  ())

(defvar *response-file-temp-dir* nil)

(defun with-response-file-impl (body-func)
  (let* ((response-file-name (format nil "response~A.lisp"
                                     (random #.(1- (expt 2 64)))))
         (response-file (if *response-file-temp-dir*
                            (merge-pathnames response-file-name *response-file-temp-dir*)
                            (progn (log:warn "~A is not set, temporary resposne file will be created in the default directory."
                                             '*response-file-temp-dir*)
                                   response-file-name))))
    (unwind-protect (progn (funcall body-func response-file)
                           (handler-case
                               (test-grid-utils::safe-read-file response-file)
                             (serious-condition (condition)
                               (error 'no-response :cause condition
                                      :format-control "Error reading response file ~A. Caused by serious condition \"~A\" of type ~A."
                                      :format-arguments (list response-file condition (type-of condition))))))
      (when (probe-file response-file)
        (delete-file response-file)))))

(defmacro with-response-file ((file-var) &body body)
  `(with-response-file-impl (lambda (,file-var) ,@body)))
Something went wrong with that request. Please try again.