;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit common))
(declare (uses commonmod))
(declare (uses processmod))
(declare (uses configfmod))
(declare (uses rmtmod))
(declare (uses debugprint))
(declare (uses mtargs))
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
format dot-locking csv-xml z3 udp ;; sql-de-lite
hostinfo md5 message-digest typed-records directory-utils stack
matchable regex posix (srfi 18) extras ;; tcp
(prefix nanomsg nmsg:)
(prefix sqlite3 sqlite3:)
pkts (prefix dbi dbi:)
)
(use posix-extras pathname-expand files)
(import commonmod
processmod
debugprint
configfmod
rmtmod
(prefix mtargs args:))
(include "common_records.scm")
;;======================================================================
;; (define *common:telemetry-log-state* 'startup)
;; (define *common:telemetry-log-socket* #f)
;;
;; (define (common:telemetry-log-open)
;; (if (eq? *common:telemetry-log-state* 'startup)
;; (let* ((serverhost (configf:lookup *configdat* "telemetry" "host"))
;; (serverport (configf:lookup-number *configdat* "telemetry" "port"))
;; (user (or (get-environment-variable "USER") "unknown"))
;; (host (or (get-environment-variable "HOST") "unknown")))
;; (set! *common:telemetry-log-state*
;; (handle-exceptions
;; exn
;; (begin
;; (debug:print-info 0 *default-log-port* "common-telemetry-log open udp port failure")
;; 'broken)
;; (if (and serverhost serverport user host)
;; (let* ((s (udp-open-socket)))
;; ;;(udp-bind! s #f 0)
;; (udp-connect! s serverhost serverport)
;; (set! *common:telemetry-log-socket* s)
;; 'open)
;; 'not-needed))))))
;;
;; (define (common:telemetry-log event #!key (payload '()))
;; (if (eq? *common:telemetry-log-state* 'startup)
;; (common:telemetry-log-open))
;;
;; (if (eq? 'open *common:telemetry-log-state*)
;; (handle-exceptions
;; exn
;; (begin
;; (debug:print-info 0 *default-log-port* "common-telemetry-log comms failure ; disabled (no server?)")
;; ;;(define *common:telemetry-log-state* 'broken-or-no-server-preclose)
;; ;;(common:telemetry-log-close)
;; (define *common:telemetry-log-state* 'broken-or-no-server)
;; (set! *common:telemetry-log-socket* #f)
;; )
;; (if (and *common:telemetry-log-socket* event) ;; TODO - filter on event against telemetry.want-events
;; (let* ((user (or (get-environment-variable "USER") "unknown"))
;; (host (or (get-environment-variable "HOST") "unknown"))
;; (start (conc "[megatest "event"]"))
;; (toppath (or *toppath* "/dev/null"))
;; (payload-serialized
;; (base64:base64-encode
;; (z3:encode-buffer
;; (with-output-to-string (lambda () (pp payload))))))
;; (msg (conc user":"host":"start":"(current-process-id)":"(car (argv))":"
;; toppath":"payload-serialized)))
;; (udp-send *common:telemetry-log-socket* msg))))))
;;
;; (define (common:telemetry-log-close)
;; (when (or (member *common:telemetry-log-state* '(broken-or-no-server-preclose open)) *common:telemetry-log-socket*)
;; (handle-exceptions
;; exn
;; (begin
;; (define *common:telemetry-log-state* 'closed-fail)
;; (debug:print-info 0 *default-log-port* "common-telemetry-log closure failure")
;; )
;; (begin
;; (define *common:telemetry-log-state* 'closed)
;; (udp-close-socket *common:telemetry-log-socket*)
;; (set! *common:telemetry-log-socket* #f)))))