jami/jami-daemon
1
0
Fork 0
mirror of https://git.jami.net/savoirfairelinux/jami-daemon.git synced 2025-08-12 22:09:25 +08:00
Code Issues Projects Releases Wiki Activity

agent: Use GOOPS

Browse Source 
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
This commit is contained in:
Olivier Dion
2021-12-09 12:03:18 -05:00
committed by Sébastien Blin
parent cefe9ce86b
commit ce1995d172
7 changed files with 271 additions and 142 deletions
Download Patch File Download Diff File Expand all files Collapse all files

150
test/agent/agent.scm
View File

@ -18,57 +18,121 @@
(define-module (agent) (define-module (agent)
#:use-module (ice-9 threads) #:use-module (ice-9 threads)
#:use-module (ice-9 receive)
#:use-module (oop goops)
#:use-module ((jami logger) #:prefix jami:) #:use-module ((jami logger) #:prefix jami:)
#:use-module ((jami account) #:prefix account:) #:use-module ((jami account) #:prefix account:)
#:use-module ((jami call) #:prefix call:) #:use-module ((jami call) #:prefix call:)
#:use-module ((jami signal) #:prefix jami:) #:use-module ((jami signal) #:prefix jami:)
#:export (ensure-account #:export (<agent>
ensure-account-from-archive)) call-friend
make-agent
make-friend
account-id
peer-id))
(define-public account-id (make-parameter "afafafafafafafaf")) (define %default-details
(define-public peer-id (make-parameter #f)) '(("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)) (define (make-account this-account-id account-details timeout)
(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))
(with-mutex mtx (if (null? (account:get-details this-account-id))
(wait-condition-variable cnd mtx))) (account:add account-details this-account-id)
(account:set-details this-account-id '(("Account.enable" . "true"))))
(when (null? (account:get-details this-account-id)) (let ([mtx (make-recursive-mutex)]
(account:add account-details this-account-id))) [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))) (unless (wait-condition-variable cnd mtx
(peer-id (assoc-ref details "Account.username")))) (+ (current-time) timeout))
(throw 'make-account-timeout this-account-id account-details))))
(define* (ensure-account #:key (wait-for-announcement? #t)) (values this-account-id (assoc-ref (account:get-details this-account-id)
(jami:info "Ensure account") "Account.username")))
(ensure-account% (account-id) '(("Account.type" . "RING")
("Account.displayName" . "AGENT")
("Account.alias" . "AGENT")
("Account.archivePassword" . "")
("Account.archivePIN" . "")
("Account.archivePath" . ""))
wait-for-announcement?))
(define* (ensure-account-from-archive path #:key (wait-for-announcement? #t)) (define-class <agent> ()
(jami:info "Ensure account from archive ~a" path) (account-id
(ensure-account% (account-id) `(("Account.type" . "RING") #:getter account-id
("Account.displayName" . "AGENT") #:init-keyword #:account)
("Account.alias" . "AGENT") (peer-id
("Account.archivePassword" . "") #:getter peer-id
("Account.archivePIN" . "") #:init-keyword #:peer)
("Account.archivePath" . ,path)) (account-details
wait-for-announcement?)) #: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 <agent>) port)
(format port "<agent: account=~a, peer-id=~a>"
(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 <agent>
#:account account-id
#:peer peer-id))))
(define-method (call-friend (A <agent>) (peer <string>))
"Agent A calls PEER. Returns the call id."
(call:place-call/media (account-id A) peer))
(define-method (call-friend (A <agent>) (B <agent>))
"Agent A calls agent B. Returns the call id."
(call-friend A (peer-id B)))
(define-method (make-friend (self <agent>) (peer-id <string>) (timeout <number>))
(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 <agent>) (peer-id <string>))
(make-friend self peer-id 30))
(define-method (make-friend (A <agent>) (B <agent>) . args)
(apply make-friend (append (list A (peer-id B)) args)))

23
test/agent/examples/active-agent.scm Normal file → Executable file
View File

@ -1,3 +1,6 @@
#!/usr/bin/env -S ./agent.exe -s
!#
;;; This is an example of an active agent. ;;; This is an example of an active agent.
;;; ;;;
;;; The active agent ensure that an account is created and then call its peer ;;; The active agent ensure that an account is created and then call its peer
@ -6,7 +9,7 @@
;;; We import here Jami's primitives. ;;; We import here Jami's primitives.
(use-modules (use-modules
(ice-9 threads) (ice-9 threads)
((agent) #:prefix agent:) (agent)
((jami account) #:prefix account:) ((jami account) #:prefix account:)
((jami signal) #:prefix jami:) ((jami signal) #:prefix jami:)
((jami call) #:prefix call:) ((jami call) #:prefix call:)
@ -45,28 +48,24 @@ hang up after MEDIA-FLOW seconds and #t is returned.
(set! continue #f) (set! continue #f)
success)))) success))))
;;; This ensure you have an account created for the agent. (define peer "FIXME")
(agent:ensure-account)
;;; Change FIXME for the peer id you want to contact. You can also change the (define agent (make-agent "bfbfbfbfbfbfbfbf"))
;;; value of media-flow and grace-period.
(let loop ([account (agent:account-id)] (make-friend agent peer)
[peer "FIXME"]
(let loop ([account (account-id agent)]
[media-flow 7] [media-flow 7]
[grace-period 30]) [grace-period 30])
;; Calling our PEER.
(make-a-call account peer #:media-flow media-flow) (make-a-call account peer #:media-flow media-flow)
;; Disabling our account for GRACE-PERIOD.
(jami:info "Disabling account") (jami:info "Disabling account")
(account:send-register account #f) (account:send-register account #f)
(sleep grace-period) (sleep grace-period)
;; Renabling our account and wait GRACE-PERIOD.
(jami:info "Enabling account") (jami:info "Enabling account")
(account:send-register account #t) (account:send-register account #t)
(sleep grace-period) (sleep grace-period)
;; Loop again. (loop account media-flow grace-period))
(loop account peer media-flow grace-period))

1
test/agent/examples/agent.scm Symbolic link
View File

@ -0,0 +1 @@
../agent.scm

1
test/agent/examples/jami Symbolic link
View File

@ -0,0 +1 @@
../jami

40
test/agent/examples/passive-agent.scm Normal file → Executable file
View File

@ -1,22 +1,46 @@
#!/usr/bin/env -S ./agent.exe -s
!#
;;; This is an example of a passive agent. ;;; This is an example of a passive agent.
;;; ;;;
;;; The passive agent ensure that an account is created and then wait for ;;; The passive agent ensure that an account is created and accept all trust
;;; incomming call of any peer. ;;; requests and incoming calls.
(use-modules ((agent) #:prefix agent:)
(use-modules (agent)
((jami account) #:prefix account:)
((jami signal) #:prefix jami:) ((jami signal) #:prefix jami:)
((jami call) #:prefix call:) ((jami call) #:prefix call:)
((jami logger) #:prefix jami:)) ((jami logger) #:prefix jami:))
(agent:ensure-account) (define this-agent (make-agent "afafafafafafafaf"))
(jami:info "Agent peer-id: ~a" (agent:peer-id)) (let ([account (account-id this-agent)])
;; Accept all incoming calls with media.
(let ((account (agent:account-id)))
(jami:on-signal 'incoming-call/media (jami:on-signal 'incoming-call/media
(lambda (account-id call-id peer media-lst) (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) (when (string= account-id account)
(jami:info "Incoming [call:~a] from peer ~a~%" call-id peer) (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))) #t)))
(jami:info "~a" this-agent)
(while #t (pause)) (while #t (pause))

2
test/agent/scenarios/peer-monitor/run-scenario
View File

@ -1,6 +1,6 @@
#!/bin/sh #!/bin/sh
tmp=$(mktemp --directory) tmp=$(mktemp --tmpdir --directory "jami-peer-monitor.XXXXXXXXXX")
export XDG_CONFIG_HOME="$tmp" export XDG_CONFIG_HOME="$tmp"
export XDG_CACHE_HOME="$tmp" export XDG_CACHE_HOME="$tmp"

196
test/agent/scenarios/peer-monitor/scenario.scm
View File

@ -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 (use-modules
@ -7,49 +7,56 @@
(ice-9 atomic) (ice-9 atomic)
(ice-9 format) (ice-9 format)
((srfi srfi-19) #:prefix srfi-19:) ((srfi srfi-19) #:prefix srfi-19:)
((agent) #:prefix agent:) (agent)
((jami account) #:prefix account:) ((jami account) #:prefix account:)
((jami call) #:prefix call:) ((jami call) #:prefix call:)
((jami signal) #:prefix jami:) ((jami signal) #:prefix jami:)
((jami logger) #:prefix jami:)) ((jami logger) #:prefix jami:))
(define seconds-per-hour (* 60 60)) (define* (current-date #:optional (tz 0))
(define seconds-per-day (* 24 second-per-hour)) (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." "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))) (+ (* 3600 (- 23 (srfi-19:date-hour now)))
(* 60 (- 59 (srfi-19:date-minute now))) (* 60 (- 59 (srfi-19:date-minute now)))
(- 60 (srfi-19:date-second now))))) (- 60 (srfi-19:date-second now)))))
(define next-details! (define next-details!
"Returns the next details in the matrix of account's details." (let* ([details-matrix #((("Account.upnpEnabled" . "true")
(let* ((details-matrix ("TURN.enable" . "true")
#((("Account.upnpEnabled" . "true")
("TURN.enable" . "true"))
(("Account.upnpEnabled" . "true") ("Account.upnpEnabled" . "true")
("TURN.enable" . "false")) ("TURN.enable" . "false")
(("Account.upnpEnabled" . "false") ("Account.upnpEnabled" . "false")
("TURN.enable" . "true")) ("TURN.enable" . "true")
(("Account.upnpEnabled" . "false") ("Account.upnpEnabled" . "false")
("TURN.enable" . "false")))) ("TURN.enable" . "false")))]
(i 0) [i 0]
(len (array-length details-matrix))) [len (array-length details-matrix)])
(lambda () (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)) (set! i (euclidean-remainder (1+ i) len))
details)))) details))))
(define (timestamp) (define (timestamp)
(srfi-19:date->string (srfi-19:current-date) "[~5]")) (srfi-19:date->string (current-date) "[~5]"))
(define-syntax-rule (progress fmt args ...) (define-syntax-rule (progress fmt args ...)
(jami:info "~a ~a" (timestamp) (format #f 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) (define (setup-timer)
(progress "Setting up timer") (progress "Setting up timer")
@ -65,8 +72,8 @@
(sigaction SIGALRM (lambda _ (setup-timer))) (sigaction SIGALRM (lambda _ (setup-timer)))
(let ((account (agent:account-id)) (let ([account (account-id agent)]
(details (next-details!))) [details (next-details!)])
(progress "SIGALRM - Changing account details: ~a" details) (progress "SIGALRM - Changing account details: ~a" details)
(account:send-register account #f) (account:send-register account #f)
(account:set-details account details) (account:set-details account details)
@ -83,53 +90,61 @@
;; Resume execution of continuation. ;; Resume execution of continuation.
(resume #t)) (resume #t))
(define agent #f)
(define resume #f) (define resume #f)
(define (active peer) (define (active peer)
(define (call-peer timeout) (define (call-peer timeout)
(let ((mtx (make-mutex)) (let ((mtx (make-recursive-mutex))
(cnd (make-condition-variable)) (cnd (make-condition-variable))
(me (account-id agent))
(this-call-id "") (this-call-id "")
(continue (make-atomic-box #t))) (continue #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))))
(let ((account (agent:account-id)) (with-mutex mtx
(success 0) (jami:on-signal 'state-changed
(failure 0) (lambda (account-id call-id state code)
(reset (call/cc (lambda (k) (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) (set! resume k)
#f)))) #f))])
(when reset (when reset
(let ((total (+ success failure))) (let ((total (+ success failure)))
(progress "'(summary (total-call . ~a) (success-rate . ~a) (failure-rate . ~a))" (stat "'(summary (date . \"~a\") (total-call . ~a) (success-rate . ~a) (failure-rate . ~a))"
total date
(/ success total) total
(/ failure total)) (/ success total)
(set! success 0) (/ failure total))
(set! failure 0))) (set! date (timestamp))
(set! success 0)
(set! failure 0)))
(while #t (while #t
(let ((result (call-peer 30))) (let ([success? (call-peer 30)])
(progress "Call: ~a" (if result "PASS" "FAIL")) (progress "Call: ~a" (if success? "PASS" "FAIL"))
(if result (if success?
(set! success (1+ success)) (set! success (1+ success))
(set! failure (1+ failure))) (set! failure (1+ failure)))
(account:send-register account #f) (account:send-register account #f)
@ -139,36 +154,61 @@
(define (passive) (define (passive)
(jami:on-signal 'incoming-call (let ([account (account-id agent)])
(lambda (account-id call-id peer) ;; Accept all incoming calls with media.
(progress "Receiving call from ~a" peer) (jami:on-signal 'incoming-call/media
(call:accept call-id) (lambda (account-id call-id peer media-lst)
#t)) (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 ;; Accept all incoming calls.
(lambda (account-id call-id peer media-lst) (jami:on-signal 'incoming-call
(call:accept call-id media-lst) (lambda (account-id call-id peer)
#t)) (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) (set! resume k)
#t)))) #t))])
(while continue (while continue (pause))))
(pause))))
(define (main args) (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 (set! resume
(match behavior (match behavior
(("passive" archive) (lambda _ (("passive") (lambda _ (passive)))
(agent:ensure-account-from-archive (("active" peer)
archive) (lambda _
(passive))) (set! stats-output (open-output-file "stats.scm"))
(("active" archive peer) (lambda _ (setvbuf stats-output 'none)
(agent:ensure-account-from-archive (make-friend agent peer)
archive) (active peer)))
(active peer)))
(_ (throw 'bad-argument args))))) (_ (throw 'bad-argument args)))))
(setup-timer)) (setup-timer))