886
887
888
889
890
891
892
893
894
895
896
897
898
899
|
(debug:print-info 13 *default-log-port* "loading writable-watchdog.")
(server:writable-watchdog dbstruct)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
(define (std-exit-procedure)
(on-exit (lambda () 0))
;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
(let ((no-hurry (if *time-to-exit* ;; hurry up
#f
(begin
(set! *time-to-exit* #t)
#t))))
|
>
|
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
|
(debug:print-info 13 *default-log-port* "loading writable-watchdog.")
(server:writable-watchdog dbstruct)))
(debug:print-info 13 *default-log-port* "watchdog done."))
(debug:print-info 13 *default-log-port* "no need for watchdog on non-homehost"))))
(define (std-exit-procedure)
;;(common:telemetry-log-close)
(on-exit (lambda () 0))
;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
(let ((no-hurry (if *time-to-exit* ;; hurry up
#f
(begin
(set! *time-to-exit* #t)
#t))))
|
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
|
(handle-exceptions
exn
#t ;; just ignore it, it might have died in the meantime so joining it will throw an exception
(thread-join! thread))
)))
(hash-table-keys *common:thread-punchlist*)))
(define (common:telemetry-log event #!key (payload '()))
(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")))
(handle-exceptions
exn
(debug:print-info 0 *default-log-port* "common-telemetry-log failure")
(if (and serverhost serverport user host event)
(let* ((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":"
toppath":"payload-serialized))
(s (udp-open-socket)))
(udp-bind! s #f 0)
(udp-connect! s serverhost serverport)
(udp-send s msg)
(udp-close-socket s))))))
|
>
>
>
|
>
|
|
|
|
|
|
|
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
<
|
|
>
>
|
>
>
>
>
|
>
|
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
|
(handle-exceptions
exn
#t ;; just ignore it, it might have died in the meantime so joining it will throw an exception
(thread-join! thread))
)))
(hash-table-keys *common:thread-punchlist*)))
(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 get 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))
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "common-telemetry-log failure"))
(if (and *common:telemetry-log-socket* event)
(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)":"
toppath":"payload-serialized)))
(udp-send *common:telemetry-log-socket* msg)))))
(define (common:telemetry-log-close)
(when (and (eq? *common:telemetry-log-state* 'open) *common:telemetry-log-socket*)
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "common-telemetry-log closure failure"))
(begin
(udp-close-socket *common:telemetry-log-socket*)
(set! *common:telemetry-log-socket* #f)))))
|