From ce1995d1721ab392e3f341265f4de923526ad889 Mon Sep 17 00:00:00 2001 From: Olivier Dion Date: Thu, 9 Dec 2021 12:03:18 -0500 Subject: [PATCH] agent: Use GOOPS GOOPS is Guile Object Oriented Programming System. It's easier to extend and break less the scenarios using GOOPS. e.g., a scenario published on Gitlab should work two weeks later. This is not the case right now and the goal of using GOOPS is to offer a stable API for the agent, while keeping it flexible. Change-Id: If6a038b6d8c371f8e74849749770f1dec8559b91 --- test/agent/agent.scm | 150 ++++++++++---- test/agent/examples/active-agent.scm | 23 +- test/agent/examples/agent.scm | 1 + test/agent/examples/jami | 1 + test/agent/examples/passive-agent.scm | 40 +++- .../agent/scenarios/peer-monitor/run-scenario | 2 +- .../agent/scenarios/peer-monitor/scenario.scm | 196 +++++++++++------- 7 files changed, 271 insertions(+), 142 deletions(-) mode change 100644 => 100755 test/agent/examples/active-agent.scm create mode 120000 test/agent/examples/agent.scm create mode 120000 test/agent/examples/jami mode change 100644 => 100755 test/agent/examples/passive-agent.scm diff --git a/test/agent/agent.scm b/test/agent/agent.scm index 4e16d9075..8c169db9d 100644 --- a/test/agent/agent.scm +++ b/test/agent/agent.scm @@ -18,57 +18,121 @@ (define-module (agent) #:use-module (ice-9 threads) + #:use-module (ice-9 receive) + #:use-module (oop goops) #:use-module ((jami logger) #:prefix jami:) #:use-module ((jami account) #:prefix account:) #:use-module ((jami call) #:prefix call:) #:use-module ((jami signal) #:prefix jami:) - #:export (ensure-account - ensure-account-from-archive)) + #:export ( + call-friend + make-agent + make-friend + account-id + peer-id)) -(define-public account-id (make-parameter "afafafafafafafaf")) -(define-public peer-id (make-parameter #f)) +(define %default-details + '(("Account.type" . "RING") + ("Account.displayName" . "AGENT") + ("Account.alias" . "AGENT") + ("Account.archivePassword" . "") + ("Account.archivePIN" . "") + ("Account.archivePath" . ""))) -(define* (ensure-account% this-account-id account-details #:optional (wait-for-announcement? #t)) - (if wait-for-announcement? - (let ((mtx (make-mutex)) - (cnd (make-condition-variable))) - (jami:on-signal 'volatile-details-changed - (lambda (accountID details) - (cond - ((and (string= accountID this-account-id) - (string= "true" (assoc-ref details "Account.deviceAnnounced"))) - (with-mutex mtx - (signal-condition-variable cnd) - #f)) - (else #t)))) - (when (null? (account:get-details this-account-id)) - (account:add account-details this-account-id)) +(define (make-account this-account-id account-details timeout) - (with-mutex mtx - (wait-condition-variable cnd mtx))) + (if (null? (account:get-details this-account-id)) + (account:add account-details this-account-id) + (account:set-details this-account-id '(("Account.enable" . "true")))) - (when (null? (account:get-details this-account-id)) - (account:add account-details this-account-id))) + (let ([mtx (make-recursive-mutex)] + [cnd (make-condition-variable)]) + (with-mutex mtx + (jami:on-signal 'volatile-details-changed + (lambda (account-id details) + (with-mutex mtx + (let ([done? + (and (string= account-id this-account-id) + (string= "true" (or (assoc-ref + details + "Account.deviceAnnounced") + "false")))]) + (when done? + (signal-condition-variable cnd)) + (not done?))))) - (let ((details (account:get-details this-account-id))) - (peer-id (assoc-ref details "Account.username")))) + (unless (wait-condition-variable cnd mtx + (+ (current-time) timeout)) + (throw 'make-account-timeout this-account-id account-details)))) -(define* (ensure-account #:key (wait-for-announcement? #t)) - (jami:info "Ensure account") - (ensure-account% (account-id) '(("Account.type" . "RING") - ("Account.displayName" . "AGENT") - ("Account.alias" . "AGENT") - ("Account.archivePassword" . "") - ("Account.archivePIN" . "") - ("Account.archivePath" . "")) - wait-for-announcement?)) + (values this-account-id (assoc-ref (account:get-details this-account-id) + "Account.username"))) -(define* (ensure-account-from-archive path #:key (wait-for-announcement? #t)) - (jami:info "Ensure account from archive ~a" path) - (ensure-account% (account-id) `(("Account.type" . "RING") - ("Account.displayName" . "AGENT") - ("Account.alias" . "AGENT") - ("Account.archivePassword" . "") - ("Account.archivePIN" . "") - ("Account.archivePath" . ,path)) - wait-for-announcement?)) +(define-class () + (account-id + #:getter account-id + #:init-keyword #:account) + (peer-id + #:getter peer-id + #:init-keyword #:peer) + (account-details + #:allocation #:virtual + #:slot-ref (lambda (this) + (account:get-details (account-id this))) + #:slot-set! (lambda (this details) + (account:set-details (account-id this) details)))) + +(define-method (display (self ) port) + (format port "" + (account-id self) + (peer-id self))) + +(define* (make-agent account-id #:key (details #nil) (timeout 60)) + "Make an agent with ACCOUNT-ID and additional DETAILS. If not announced on +the DHT before TIMEOUT, throw 'make-account-timeout." + + (jami:info "making agent: ~a" account-id) + + (let ([full-details (append details %default-details)]) + (receive (account-id peer-id) + (make-account account-id full-details timeout) + (make + #:account account-id + #:peer peer-id)))) + + +(define-method (call-friend (A ) (peer )) + "Agent A calls PEER. Returns the call id." + (call:place-call/media (account-id A) peer)) + +(define-method (call-friend (A ) (B )) + "Agent A calls agent B. Returns the call id." + (call-friend A (peer-id B))) + +(define-method (make-friend (self ) (peer-id ) (timeout )) + + (jami:info "making friend between ~a ~a" self peer-id) + + (let ([mtx (make-mutex)] + [cnd (make-condition-variable)] + [me (account-id self)] + [friend peer-id]) + (with-mutex mtx + (jami:on-signal 'contact-added + (lambda (id uri confirmed) + (with-mutex mtx + (if (and (string= id me) + (string= uri friend) + confirmed) + (begin + (signal-condition-variable cnd) + #f) + #t)))) + (account:send-trust-request me friend) + (wait-condition-variable cnd mtx (+ (current-time) timeout))))) + +(define-method (make-friend (self ) (peer-id )) + (make-friend self peer-id 30)) + +(define-method (make-friend (A ) (B ) . args) + (apply make-friend (append (list A (peer-id B)) args))) diff --git a/test/agent/examples/active-agent.scm b/test/agent/examples/active-agent.scm old mode 100644 new mode 100755 index bdde63909..d88395a84 --- a/test/agent/examples/active-agent.scm +++ b/test/agent/examples/active-agent.scm @@ -1,3 +1,6 @@ +#!/usr/bin/env -S ./agent.exe -s +!# + ;;; This is an example of an active agent. ;;; ;;; The active agent ensure that an account is created and then call its peer @@ -6,7 +9,7 @@ ;;; We import here Jami's primitives. (use-modules (ice-9 threads) - ((agent) #:prefix agent:) + (agent) ((jami account) #:prefix account:) ((jami signal) #:prefix jami:) ((jami call) #:prefix call:) @@ -45,28 +48,24 @@ hang up after MEDIA-FLOW seconds and #t is returned. (set! continue #f) success)))) -;;; This ensure you have an account created for the agent. -(agent:ensure-account) +(define peer "FIXME") -;;; Change FIXME for the peer id you want to contact. You can also change the -;;; value of media-flow and grace-period. -(let loop ([account (agent:account-id)] - [peer "FIXME"] +(define agent (make-agent "bfbfbfbfbfbfbfbf")) + +(make-friend agent peer) + +(let loop ([account (account-id agent)] [media-flow 7] [grace-period 30]) - ;; Calling our PEER. (make-a-call account peer #:media-flow media-flow) - ;; Disabling our account for GRACE-PERIOD. (jami:info "Disabling account") (account:send-register account #f) (sleep grace-period) - ;; Renabling our account and wait GRACE-PERIOD. (jami:info "Enabling account") (account:send-register account #t) (sleep grace-period) - ;; Loop again. - (loop account peer media-flow grace-period)) + (loop account media-flow grace-period)) diff --git a/test/agent/examples/agent.scm b/test/agent/examples/agent.scm new file mode 120000 index 000000000..8c5386bda --- /dev/null +++ b/test/agent/examples/agent.scm @@ -0,0 +1 @@ +../agent.scm \ No newline at end of file diff --git a/test/agent/examples/jami b/test/agent/examples/jami new file mode 120000 index 000000000..9ead7fdc9 --- /dev/null +++ b/test/agent/examples/jami @@ -0,0 +1 @@ +../jami \ No newline at end of file diff --git a/test/agent/examples/passive-agent.scm b/test/agent/examples/passive-agent.scm old mode 100644 new mode 100755 index 7e9befd22..ee6150f2c --- a/test/agent/examples/passive-agent.scm +++ b/test/agent/examples/passive-agent.scm @@ -1,22 +1,46 @@ +#!/usr/bin/env -S ./agent.exe -s +!# + ;;; This is an example of a passive agent. ;;; -;;; The passive agent ensure that an account is created and then wait for -;;; incomming call of any peer. +;;; The passive agent ensure that an account is created and accept all trust +;;; requests and incoming calls. -(use-modules ((agent) #:prefix agent:) + +(use-modules (agent) + ((jami account) #:prefix account:) ((jami signal) #:prefix jami:) ((jami call) #:prefix call:) ((jami logger) #:prefix jami:)) -(agent:ensure-account) +(define this-agent (make-agent "afafafafafafafaf")) -(jami:info "Agent peer-id: ~a" (agent:peer-id)) - -(let ((account (agent:account-id))) +(let ([account (account-id this-agent)]) + ;; Accept all incoming calls with media. (jami:on-signal 'incoming-call/media (lambda (account-id call-id peer media-lst) + (when (string= account-id account) + (jami:info "Incoming [call:~a] with media ~a from peer ~a~%" + call-id media-lst peer) + (call:accept account-id call-id media-lst)) + #t)) + ;; Accept all incoming calls. + (jami:on-signal 'incoming-call + (lambda (account-id call-id peer) (when (string= account-id account) (jami:info "Incoming [call:~a] from peer ~a~%" call-id peer) - (call:accept call-id media-lst)) + (call:accept account-id call-id)) + #t)) + + ;;; Accept all trust requests. + (jami:on-signal 'incoming-trust-request + (lambda (account-id conversation-id peer-id payload received) + (when (string= account-id account) + (jami:info "accepting trust request: ~a ~a" account-id peer-id) + (account:accept-trust-request account-id peer-id)) #t))) + + +(jami:info "~a" this-agent) + (while #t (pause)) diff --git a/test/agent/scenarios/peer-monitor/run-scenario b/test/agent/scenarios/peer-monitor/run-scenario index 1130a5e81..5c24ae9c7 100755 --- a/test/agent/scenarios/peer-monitor/run-scenario +++ b/test/agent/scenarios/peer-monitor/run-scenario @@ -1,6 +1,6 @@ #!/bin/sh -tmp=$(mktemp --directory) +tmp=$(mktemp --tmpdir --directory "jami-peer-monitor.XXXXXXXXXX") export XDG_CONFIG_HOME="$tmp" export XDG_CACHE_HOME="$tmp" diff --git a/test/agent/scenarios/peer-monitor/scenario.scm b/test/agent/scenarios/peer-monitor/scenario.scm index 04ff4c5c8..24c2c93b5 100755 --- a/test/agent/scenarios/peer-monitor/scenario.scm +++ b/test/agent/scenarios/peer-monitor/scenario.scm @@ -1,4 +1,4 @@ -#!/usr/bin/env -S ./agent.exe -e main -s +#!/usr/bin/env -S ./agent.exe --debug -e main -s !# (use-modules @@ -7,49 +7,56 @@ (ice-9 atomic) (ice-9 format) ((srfi srfi-19) #:prefix srfi-19:) - ((agent) #:prefix agent:) + (agent) ((jami account) #:prefix account:) ((jami call) #:prefix call:) ((jami signal) #:prefix jami:) ((jami logger) #:prefix jami:)) -(define seconds-per-hour (* 60 60)) -(define seconds-per-day (* 24 second-per-hour)) +(define* (current-date #:optional (tz 0)) + (srfi-19:current-date tz)) -(define* (time-until-midnight #:optional (tz 0)) +(define seconds-per-hour (* 60 60)) +(define seconds-per-day (* 24 seconds-per-hour)) + +(define* (time-until-midnight) "Returns the number of seconds before midnight at timezone offset TZ." - (let ((now (srfi-19:current-date 0))) + (let ((now (current-date))) (+ (* 3600 (- 23 (srfi-19:date-hour now))) (* 60 (- 59 (srfi-19:date-minute now))) (- 60 (srfi-19:date-second now))))) (define next-details! - "Returns the next details in the matrix of account's details." - (let* ((details-matrix - #((("Account.upnpEnabled" . "true") - ("TURN.enable" . "true")) + (let* ([details-matrix #((("Account.upnpEnabled" . "true") + ("TURN.enable" . "true") - (("Account.upnpEnabled" . "true") - ("TURN.enable" . "false")) + ("Account.upnpEnabled" . "true") + ("TURN.enable" . "false") - (("Account.upnpEnabled" . "false") - ("TURN.enable" . "true")) + ("Account.upnpEnabled" . "false") + ("TURN.enable" . "true") - (("Account.upnpEnabled" . "false") - ("TURN.enable" . "false")))) - (i 0) - (len (array-length details-matrix))) + ("Account.upnpEnabled" . "false") + ("TURN.enable" . "false")))] + [i 0] + [len (array-length details-matrix)]) (lambda () - (let ((details (array-ref details-matrix i))) + "Returns the next details in the matrix of account's details." + (let ([details (array-ref details-matrix i)]) (set! i (euclidean-remainder (1+ i) len)) details)))) (define (timestamp) - (srfi-19:date->string (srfi-19:current-date) "[~5]")) + (srfi-19:date->string (current-date) "[~5]")) (define-syntax-rule (progress fmt args ...) (jami:info "~a ~a" (timestamp) (format #f fmt args ...))) +(define stats-output #t) + +(define-syntax-rule (stat fmt args ...) + (format stats-output fmt args ...)) + (define (setup-timer) (progress "Setting up timer") @@ -65,8 +72,8 @@ (sigaction SIGALRM (lambda _ (setup-timer))) - (let ((account (agent:account-id)) - (details (next-details!))) + (let ([account (account-id agent)] + [details (next-details!)]) (progress "SIGALRM - Changing account details: ~a" details) (account:send-register account #f) (account:set-details account details) @@ -83,53 +90,61 @@ ;; Resume execution of continuation. (resume #t)) +(define agent #f) (define resume #f) (define (active peer) (define (call-peer timeout) - (let ((mtx (make-mutex)) + (let ((mtx (make-recursive-mutex)) (cnd (make-condition-variable)) + (me (account-id agent)) (this-call-id "") - (continue (make-atomic-box #t))) - (jami:on-signal 'state-changed - (lambda (call-id state code) - (if (atomic-box-ref continue) - (with-mutex mtx - (if (and (string= this-call-id call-id) - (string= state "CURRENT")) - (begin - (signal-condition-variable cnd) - #f) - #t)) - #f))) - (with-mutex mtx - (set! this-call-id (call:place-call (agent:account-id) peer)) - (let ((ret (wait-condition-variable cnd mtx - (+ (current-time) timeout)))) - (unless ret (atomic-box-set! continue #f)) - ret)))) + (continue #t)) - (let ((account (agent:account-id)) - (success 0) - (failure 0) - (reset (call/cc (lambda (k) + (with-mutex mtx + (jami:on-signal 'state-changed + (lambda (account-id call-id state code) + (with-mutex mtx + (when (and continue + (string= account-id me) + (string= call-id this-call-id) + (string= "CURRENT" state)) + (signal-condition-variable cnd)) + continue))) + + (set! this-call-id (call-friend agent peer)) + + (let ([success (wait-condition-variable cnd mtx + (+ (current-time) timeout))]) + (when success + (call:hang-up me this-call-id)) + (set! continue #f) + success)))) + + (let ([account (account-id agent)] + [success 0] + [failure 0] + [date (timestamp)] + [reset (call/cc (lambda (k) (set! resume k) - #f)))) + #f))]) (when reset - (let ((total (+ success failure))) - (progress "'(summary (total-call . ~a) (success-rate . ~a) (failure-rate . ~a))" - total - (/ success total) - (/ failure total)) - (set! success 0) - (set! failure 0))) + (let ((total (+ success failure))) + (stat "'(summary (date . \"~a\") (total-call . ~a) (success-rate . ~a) (failure-rate . ~a))" + date + total + (/ success total) + (/ failure total)) + (set! date (timestamp)) + (set! success 0) + (set! failure 0))) (while #t - (let ((result (call-peer 30))) - (progress "Call: ~a" (if result "PASS" "FAIL")) - (if result + (let ([success? (call-peer 30)]) + (progress "Call: ~a" (if success? "PASS" "FAIL")) + (if success? (set! success (1+ success)) (set! failure (1+ failure))) (account:send-register account #f) @@ -139,36 +154,61 @@ (define (passive) - (jami:on-signal 'incoming-call - (lambda (account-id call-id peer) - (progress "Receiving call from ~a" peer) - (call:accept call-id) - #t)) + (let ([account (account-id agent)]) + ;; Accept all incoming calls with media. + (jami:on-signal 'incoming-call/media + (lambda (account-id call-id peer media-lst) + (when (string= account-id account) + (jami:info "Incoming [call:~a] with media ~a from peer ~a~%" + call-id media-lst peer) + (call:accept account-id call-id media-lst)) + #t)) - (jami:on-signal 'incoming-call/media - (lambda (account-id call-id peer media-lst) - (call:accept call-id media-lst) - #t)) + ;; Accept all incoming calls. + (jami:on-signal 'incoming-call + (lambda (account-id call-id peer) + (when (string= account-id account) + (jami:info "Incoming [call:~a] from peer ~a~%" call-id peer) + (call:accept account-id call-id)) + #t)) - (let ((continue (call/cc (lambda (k) + ;; Accept all trust requests. + (jami:on-signal 'incoming-trust-request + (lambda (account-id conversation-id peer-id payload received) + (when (string= account-id account) + (jami:info "accepting trust request: ~a ~a" account-id peer-id) + (account:accept-trust-request account-id peer-id)) + #t))) + + (let ([continue (call/cc (lambda (k) (set! resume k) - #t)))) - (while continue - (pause)))) + #t))]) + (while continue (pause)))) (define (main args) - (let ((behavior (cdr args))) + (set! agent (make-agent + "afafafafafafafaf")) + + (progress "I am ~a" agent) + + ;; For debugging purpose, you can text the agent. + (jami:on-signal 'message-received + (lambda (account-id conv-id commit) + (progress "Message received: ~a ~a: ~a" + account-id conv-id commit) + #t)) + + (let ([behavior (cdr args)]) (set! resume (match behavior - (("passive" archive) (lambda _ - (agent:ensure-account-from-archive - archive) - (passive))) - (("active" archive peer) (lambda _ - (agent:ensure-account-from-archive - archive) - (active peer))) + (("passive") (lambda _ (passive))) + (("active" peer) + (lambda _ + (set! stats-output (open-output-file "stats.scm")) + (setvbuf stats-output 'none) + (make-friend agent peer) + (active peer))) (_ (throw 'bad-argument args))))) (setup-timer))