mirror of
https://git.jami.net/savoirfairelinux/jami-daemon.git
synced 2025-08-12 22:09:25 +08:00
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
This commit is contained in:
Olivier Dion
committed by
Sébastien Blin
Sébastien Blin
parent
cefe9ce86b
commit
ce1995d172
@ -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 (<agent>
|
||||
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)))
|
||||
(define (make-account this-account-id account-details timeout)
|
||||
|
||||
(if (null? (account:get-details this-account-id))
|
||||
(account:add account-details this-account-id)
|
||||
(account:set-details this-account-id '(("Account.enable" . "true"))))
|
||||
|
||||
(let ([mtx (make-recursive-mutex)]
|
||||
[cnd (make-condition-variable)])
|
||||
(with-mutex mtx
|
||||
(jami:on-signal 'volatile-details-changed
|
||||
(lambda (accountID details)
|
||||
(cond
|
||||
((and (string= accountID this-account-id)
|
||||
(string= "true" (assoc-ref details "Account.deviceAnnounced")))
|
||||
(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?)))))
|
||||
|
||||
(unless (wait-condition-variable cnd mtx
|
||||
(+ (current-time) timeout))
|
||||
(throw 'make-account-timeout this-account-id account-details))))
|
||||
|
||||
(values this-account-id (assoc-ref (account:get-details this-account-id)
|
||||
"Account.username")))
|
||||
|
||||
(define-class <agent> ()
|
||||
(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 <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))
|
||||
(else #t))))
|
||||
(when (null? (account:get-details this-account-id))
|
||||
(account:add account-details this-account-id))
|
||||
#f)
|
||||
#t))))
|
||||
(account:send-trust-request me friend)
|
||||
(wait-condition-variable cnd mtx (+ (current-time) timeout)))))
|
||||
|
||||
(with-mutex mtx
|
||||
(wait-condition-variable cnd mtx)))
|
||||
(define-method (make-friend (self <agent>) (peer-id <string>))
|
||||
(make-friend self peer-id 30))
|
||||
|
||||
(when (null? (account:get-details this-account-id))
|
||||
(account:add account-details this-account-id)))
|
||||
|
||||
(let ((details (account:get-details this-account-id)))
|
||||
(peer-id (assoc-ref details "Account.username"))))
|
||||
|
||||
(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?))
|
||||
|
||||
(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-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
23
test/agent/examples/active-agent.scm
Normal file → Executable file
@ -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))
|
||||
|
||||
1
test/agent/examples/agent.scm
Symbolic link
1
test/agent/examples/agent.scm
Symbolic link
@ -0,0 +1 @@
|
||||
../agent.scm
|
||||
1
test/agent/examples/jami
Symbolic link
1
test/agent/examples/jami
Symbolic link
@ -0,0 +1 @@
|
||||
../jami
|
||||
40
test/agent/examples/passive-agent.scm
Normal file → Executable file
40
test/agent/examples/passive-agent.scm
Normal file → Executable file
@ -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))
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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))"
|
||||
(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,35 +154,60 @@
|
||||
|
||||
(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)
|
||||
(call:accept call-id 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))
|
||||
|
||||
(let ((continue (call/cc (lambda (k)
|
||||
;; 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))
|
||||
|
||||
;; 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)
|
||||
(("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)))))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user