From c9362c643e2264d633cb228028b69f225b0958a8 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Mon, 13 Jun 2011 14:00:21 +0200 Subject: [PATCH] callagent: Add SIP UserAgent/Transport/Transaction code The code is not yet fully working, it is missing sending the request, dealing with timeouts, parsing the response, callbacks and everything. --- DESIGN | 31 ++++ callagent/SIPCallAgent.st | 189 ++++++++++++++++++++ callagent/SIPDialog.st | 95 ++++++++++ callagent/{SIPLogAgrea.st => SIPLogArea.st} | 0 callagent/SIPRandom.st | 18 ++ callagent/SIPRequests.st | 82 ++++++--- callagent/SIPTransactions.st | 116 ++++++++++++ package.xml | 9 + 8 files changed, 514 insertions(+), 26 deletions(-) create mode 100644 DESIGN create mode 100644 callagent/SIPCallAgent.st create mode 100644 callagent/SIPDialog.st rename callagent/{SIPLogAgrea.st => SIPLogArea.st} (100%) create mode 100644 callagent/SIPTransactions.st diff --git a/DESIGN b/DESIGN new file mode 100644 index 0000000..c7755aa --- /dev/null +++ b/DESIGN @@ -0,0 +1,31 @@ +Some simple notes on SIP + +- SIPGrammar parses and Request/Response +- SIPRequest is base to requests +- SIPResponse is the response class + +- SIPDialog holds state of a dialogue + - to/from/to tag/from tag... + - call id... maybe SDP... + +- SIPTransport is base class for the transport + - SIPUdpTransport sends and listens on UDP + +- SIPUserAgent + - Holds a SIPTransport + - Generates various ids and fills requests + - Will dispatch response to the transaction + +- SIPTransactionBase is the base for transactions + - SIPInviteTransaction is to create a call + + +Timeouts/Retransmission: + - good question, next question.. not solved yet + + + +Limitations: + - Multiple Via's are not supported + - No retranmission, no response parsing.. + diff --git a/callagent/SIPCallAgent.st b/callagent/SIPCallAgent.st new file mode 100644 index 0000000..2ea858e --- /dev/null +++ b/callagent/SIPCallAgent.st @@ -0,0 +1,189 @@ +" + (C) 2011 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +Object subclass: SIPTransport [ + | queue sem handler | + + + + SIPTransport class >> type [ + + ^ self subclassResponsibility + ] + + SIPTransport class >> new [ + + ^ super new + initialize; + yourself + ] + + initialize [ + queue := SharedQueue new. + sem := Semaphore forMutualExclusion. + ] + + queueData: aDatagram [ + queue nextPut: aDatagram. + ] + + handleData: aData [ + + [ + handler isNil + ifTrue: [self logError: 'No handler for data.' area: #sip] + ifFalse: [handler transportData: self data: aData] + ] on: Error do: [:e | + self logException: 'HandleData %1' % {e tag} area: #sip + ] + ] + + handler: aHandler [ + + handler := aHandler + ] + + address [ + + ^ self subclassResponsibility + ] + + type [ + + ^ self class type + ] +] + +SIPTransport subclass: SIPUdpTransport [ + | socket rx tx | + + + + SIPUdpTransport class >> type [ + + ^ 'UDP' + ] + + SIPUdpTransport class >> startOn: anAddress [ + + + ^ (self new) + initialize: anAddress; + yourself + ] + + address [ + + ^ socket address + ] + + initialize: anAddress [ + sem := Semaphore forMutualExclusion. + socket := Sockets.DatagramSocket local: anAddress port: 5060. + ] + + start [ + "Receive datagrams from the socket..." + rx := [ + [ | data | + data := socket next. + data ifNotNil: [ + sem critical: [self handleData: data]. + ]. + ] repeat. + ] fork. + + "Send data to the MGWs" + tx := [ + [ | data | + data := queue next. + socket nextPut: data. + ] repeat. + ] fork. + ] +] + +Object subclass: SIPUserAgent [ + | transport name last_cseq transactions | + + + + SIPUserAgent class >> createOn: aTransport [ + + ^ self new + instVarNamed: #last_cseq put: 0; + transport: aTransport; + yourself + ] + + SIPUserAgent class >> branchStart [ + + "magic marker..." + ^ 'z9hG4bK' + ] + + SIPUserAgent class >> generateBranch [ + | data | + data := '%1,%2' % {DateTime now asUTC asSeconds. Random between: 0 and: 99999}. + ^ SIPBase64 encode: data. + ] + + injectDefaults: aRequest [ + aRequest addParameter: 'Max-Forwards' value: '70'. + aRequest addParameter: 'User-Agent' value: self name. + ] + + generateVia: aBranch [ + + + ^ 'SIP/2.0/%1 %2;branch=%3%4' % + {transport type. transport address. + self class branchStart. aBranch} + ] + + generateCSeq [ + + last_cseq := (last_cseq + 1) \\ (2 raisedTo: 31). + ^ last_cseq + ] + + name [ + + ^ name ifNil: ['OsmoST-SIP 0.34'] + ] + + transport: aTransport [ + transport ifNotNil: [transport handler: nil]. + + transport := aTransport. + transport handler: self. + ] + + transportData: aTransport data: aData [ + self notYetImplemented + ] + + transactions [ + + ^ transactions ifNil: [transactions := OrderedCollection new] + ] + + addTransaction: aTransaction [ + self transactions add: aTransaction + ] +] diff --git a/callagent/SIPDialog.st b/callagent/SIPDialog.st new file mode 100644 index 0000000..43535de --- /dev/null +++ b/callagent/SIPDialog.st @@ -0,0 +1,95 @@ +" + (C) 2011 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +Object subclass: SIPDialog [ + | from from_tag to to_tag dest_ip dest_port is_client call_id | + + + + SIPDialog class >> generateTag [ + ^ SIPRandomHelper generateTag + ] + + SIPDialog class >> generateCallId [ + ^ SIPRandomHelper generateCallId + ] + + SIPDialog class >> fromUser: aFrom host: aHost port: aPort [ + + ^ self new + instVarNamed: #from put: aFrom; + instVarNamed: #from_tag put: self generateTag; + instVarNamed: #dest_ip put: aHost; + instVarNamed: #dest_port put: aPort; + instVarNamed: #is_client put: true; + instVarNamed: #call_id put: self generateCallId; + yourself + ] + + isClient [ + + ^ is_client + ] + + from: aFrom [ + + from := aFrom + ] + + fromTag: aTag [ + + from_tag := aTag + ] + + to: aTo [ + + to := aTo + ] + + toTag: aTag [ + + ] + + callId [ + ^ call_id + ] + + generateTo [ + + ^ to_tag isNil + ifTrue: ['<%1>' % {to}] + ifFalse: ['<%1>;tag=%2' % {to. to_tag}] + ] + + generateFrom [ + + ^ from_tag isNil + ifTrue: ['<%1>' % {from}] + ifFalse: ['<%1>;tag=%2' % {from. from_tag}] + ] + + destinationAddress [ + ^ is_client + ifTrue: [to] + ifFalse: [from] + ] + + from [ + ^ from + ] +] diff --git a/callagent/SIPLogAgrea.st b/callagent/SIPLogArea.st similarity index 100% rename from callagent/SIPLogAgrea.st rename to callagent/SIPLogArea.st diff --git a/callagent/SIPRandom.st b/callagent/SIPRandom.st index 2cf92cf..cefe267 100644 --- a/callagent/SIPRandom.st +++ b/callagent/SIPRandom.st @@ -16,6 +16,8 @@ along with this program. If not, see . " +PackageLoader fileInPackage: 'Sockets'. + Object subclass: SIPBase64 [ SIPBase64 class >> encode: aString [ ^ (Base64MimeConverter mimeEncode: aString readStream) contents @@ -53,3 +55,19 @@ Object subclass: SIPSecureRandom [ ] ] ] + +Object subclass: SIPRandomHelper [ + + + SIPRandomHelper class >> generateTag [ + + ^ SIPBase64 encode: '%1%2' % { + DateTime now asSeconds. SIPSecureRandom nextInt} + ] + + SIPRandomHelper class >> generateCallId [ + ^ '%1@%2' % { + SIPBase64 encode: SIPSecureRandom nextInt asString. + Sockets.SocketAddress localHostName.} + ] +] diff --git a/callagent/SIPRequests.st b/callagent/SIPRequests.st index 28d975f..8c30c4a 100644 --- a/callagent/SIPRequests.st +++ b/callagent/SIPRequests.st @@ -19,23 +19,23 @@ "TODO: Compare with MGCPCommands and share code..." Object subclass: SIPRequest [ - | addr parameters sdp | + | addr parameters sdp dialog | - sipAddr: anAddr [ - - addr := anAddr + SIPRequest class >> from: aDialog [ + ^ self new + instVarNamed: #dialog put: aDialog; + yourself ] - sipAddr [ - - ^ addr + dialog [ + ^ dialog ] parameters [ - ^ parameters ifNil: [parameters := OrderedCollection new] + ^ parameters ifNil: [parameters := Dictionary new] ] sdp: aSDP [ @@ -44,8 +44,9 @@ Object subclass: SIPRequest [ ] addParameter: name value: aValue [ + "TODO: What about multiple Via's...?" - self parameters add: '%1: %2' % {name. aValue} + self parameters at: name put: aValue. ] asDatagram [ @@ -53,45 +54,74 @@ Object subclass: SIPRequest [ out := WriteStream on: (String new). out - nextPutAll: '%1 %2 SIP/2.0' % {self class verb. self sipAddr}; + nextPutAll: '%1 %2 SIP/2.0' % {self class verb. dialog destinationAddress}; cr; nl. - self parameters do: [:each | - out nextPutAll: each; cr; nl + self parameters keysAndValuesDo: [:key :value | + out + nextPutAll: key; + nextPutAll: ': '; + nextPutAll: value; + cr; nl. ]. - out cr; nl. + self addDefaults: out. - sdp ifNotNil: [ - out nextPutAll: sdp + sdp isNil + ifTrue: [out cr; nl.] + ifFalse: [ + out + nextPutAll: 'Content-Type: application/sdp'; cr; nl; + nextPutAll: 'Content-Length: '; nextPutAll: sdp size asString; cr; nl; + cr; nl; + nextPutAll: sdp. ]. ^ out contents ] -] -SIPRequest subclass: SIPInviteCommand [ - - - SIPInviteCommand class >> verb [ - - ^ 'INVITE' + addDefaults: out [ + self parameters at: 'To' ifAbsent: [ + out + nextPutAll: 'To: %1' % {dialog generateTo}; cr;nl]. + self parameters at: 'From' ifAbsent: [ + out + nextPutAll: 'From: %1' % {dialog generateFrom}; cr;nl]. ] ] -SIPRequest subclass: SIPCancelCommand [ +SIPRequest subclass: SIPInviteRequest [ - SIPCancelCommand class >> verb [ + SIPInviteRequest class >> verb [ + + ^ 'INVITE' + ] + + addDefaults: out [ + super addDefaults: out. + + self parameters at: 'Contact' ifAbsent: [ + out nextPutAll: 'Contact: '; + nextPutAll: dialog from; + cr; nl. + ]. + ] +] + +SIPRequest subclass: SIPCancelRequest [ + + + SIPCancelRequest class >> verb [ ^ 'CANCEL' ] ] -SIPRequest subclass: SIPByeCommand [ +SIPRequest subclass: SIPByeRequest [ - SIPByeCommand class >> verb [ + SIPByeRequest class >> verb [ ^ 'BYE' ] diff --git a/callagent/SIPTransactions.st b/callagent/SIPTransactions.st new file mode 100644 index 0000000..27d17a4 --- /dev/null +++ b/callagent/SIPTransactions.st @@ -0,0 +1,116 @@ +" + (C) 2011 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +Object subclass: SIPTransaction [ + | useragent dialog state timeout success failure cseq branch | + + SIPTransaction class >> stateInitial [ ^ 0 ] + SIPTransaction class >> stateTrying [ ^ 1 ] + SIPTransaction class >> stateProceeding [ ^ 2 ] + SIPTransaction class >> stateCompleted [ ^ 3 ] + SIPTransaction class >> stateTerminated [ ^ 4 ] + + dialog: aDialog [ + dialog := aDialog + ] + + userAgent: aUA [ + + useragent := aUA + ] + + state [ + ^ state ifNil: [^ self class stateInitial] + ] + + timeout: aTimeout [ + timeout := aTimeout + ] + + success: aSuc [ + success := aSuc + ] + + failure: aFail [ + failure := aFail + ] + + setupTransaction [ + "I setup the transaction" + useragent addTransaction: self. + cseq := useragent generateCSeq. + branch := useragent class generateBranch. + ] + +] + +SIPTransaction subclass: SIPInviteTransaction [ + | sdp t1 | + + + "200ms to get TRYING or OK" + + SIPInviteTransaction class >> createWith: aDialog on: aUA with: aSDP [ + ^ self new + instVarNamed: #sdp put: aSDP; + userAgent: aUA; + dialog: aDialog; + setupTransaction; + yourself. + ] + + start [ + | invite | + + state = self class stateInitial ifFalse: [ + ^ self error: 'Can not restart.' + ]. + + "Enter the state, remember the timeout" + state := self class stateTrying. + t1 := DateTime now. + + invite := self createInvite. + ] + + checkTimeout: now [ + "Check if a timeout has happened" + self state = self class stateTrying ifTrue: [ + t1 > now ifTrue: [ + ^ true + ] + ]. + + ^ false + ] + + createInvite [ + | invite | + + + invite := (SIPInviteRequest from: dialog) + sdp: sdp; + addParameter: 'Via' value: (useragent generateVia: branch); + addParameter: 'CSeq' value: '%1 %2' % {cseq. 'INVITE'}; + addParameter: 'Allow' value: 'ACK,BYE'; + addParameter: 'Call-ID' value: dialog callId; + yourself. + useragent injectDefaults: invite. + ^ invite + ] +] diff --git a/package.xml b/package.xml index 58a0cf9..7fd13b4 100644 --- a/package.xml +++ b/package.xml @@ -2,6 +2,15 @@ OsmoSIP Osmo + callagent/Base64MimeConverter.st + callagent/SIPCallAgent.st + callagent/SIPDialog.st + callagent/SIPLogArea.st + callagent/SIPRandom.st + callagent/SIPRequests.st + callagent/SIPResponse.st + callagent/SIPTransactions.st + grammar/SIPGrammar.st