diff --git a/callagent/SIPCall.st b/callagent/SIPCall.st index d034824..65ae8fc 100644 --- a/callagent/SIPCall.st +++ b/callagent/SIPCall.st @@ -71,7 +71,8 @@ will simply ignore everything but the first dialog.'> "Check if there is a state transition" (self class legalStates includes: (self state -> aState)) ifFalse: [ - self logError: 'State transition %1->%2 is not legal' % {self state. aState} area: #sip. + self logError: 'SIPCall transition %1->%2 is not legal.' + % {self state. aState} area: #sip. ^ false ]. @@ -95,7 +96,7 @@ will simply ignore everything but the first dialog.'> (self moveToState: self class stateInvite) ifFalse: [ - self logError: 'Call failed to start.' area: #sip. + self logError: 'SIPCall failed to start.' area: #sip. ^ false ]. @@ -153,22 +154,23 @@ will simply ignore everything but the first dialog.'> callTimedOut [ - self logError: 'Call timed-out.' area: #sip. + self logError: 'SIPCall timed-out.' area: #sip. (self moveToState: self class stateTimeout) ifFalse: [ - ^ self logError: 'Call failed to move to timeout.' area: #sip. + ^ self logError: 'SIPCall failed to move to timeout.' area: #sip. ]. ] callSuccess: aResponse dialog: aDialog [ (self check: aDialog) ifFalse: [ - self logError: 'Call can only have one session. Ignoring.' area: #sip. + self logError: 'SIPCall can only have one session. Ignoring.' area: #sip. ^ false ]. + (self moveToState: self class stateSession) ifTrue: [ - self logError: 'Call session etsablished.' area: #sip. + self logError: 'SIPCall session etsablished.' area: #sip. sdp_result := aResponse sdp. self newSession. ^ true @@ -179,12 +181,12 @@ will simply ignore everything but the first dialog.'> callFailure: aResponse dialog: aDialog [ (self check: aDialog) ifFalse: [ - self logError: 'Call can only have one session. Ignoring failure.' area: #sip. + self logError: 'SIPCall can only have one session. Ignoring failure.' area: #sip. ^ false ]. (self moveToState: self class stateFailed) ifTrue: [ - self logError: 'Call Failure.' area: #sip. + self logError: 'SIPCall Failure.' area: #sip. self newFailed. ]. ] @@ -192,11 +194,11 @@ will simply ignore everything but the first dialog.'> callNotification: aResponse dialog: aDialog [ (self check: aDialog) ifFalse: [ - self logError: 'Call can only have one session. Ignoring notification.' area: #sip. + self logError: 'SIPCall can only have one session. Ignoring notification.' area: #sip. ^ false ]. - self logError: 'Call Notification.' area: #sip. + self logError: 'SIPCall Notification.' area: #sip. ] hangupTimedOut [ @@ -207,7 +209,7 @@ will simply ignore everything but the first dialog.'> hangupSuccess: aResponse dialog: aDialog [ (self check: aDialog) ifFalse: [ - self logError: 'Call can only have one session. Ignoring failure.' area: #sip. + self logError: 'SIPCall can only have one session. Ignoring failure.' area: #sip. ^ false ]. @@ -217,7 +219,7 @@ will simply ignore everything but the first dialog.'> hangupFailure: aResponse dialog: aDialog [ (self check: aDialog) ifFalse: [ - self logError: 'Call can only have one session. Ignoring failure.' area: #sip. + self logError: 'SIPCall can only have one session. Ignoring failure.' area: #sip. ^ false ]. diff --git a/callagent/SIPTransactions.st b/callagent/SIPTransactions.st index be69605..21b7006 100644 --- a/callagent/SIPTransactions.st +++ b/callagent/SIPTransactions.st @@ -29,6 +29,7 @@ Object subclass: SIPTransaction [ SIPTransaction class >> stateProceeding [ ^ #proceeding ] SIPTransaction class >> stateCompleted [ ^ #completed ] SIPTransaction class >> stateTerminated [ ^ #terminated ] + SIPTransaction class >> stateCanceled [ ^ #canceled ] SIPTransaction class >> createWith: aDialog on: aUA cseq: aCseq [ @@ -143,12 +144,10 @@ Object subclass: SIPTransaction [ failure value: aReq value: aDialog] ] - newData: aReq [ - | code dialog new_cseq | + checkSequenceNumber: aReq [ + | new_cseq | - - ('Found response %1 %2' % {aReq code. aReq phrase}) printNl. - "Compare the sequence number" + "I have to verify the sequence numbers..." new_cseq := (aReq parameter: 'CSeq' ifAbsent: [ self logError: '%1(%2) response lacks CSeq.' % {self class. self branch} area: #sip. @@ -161,25 +160,50 @@ Object subclass: SIPTransaction [ ^ false ]. - "Store all dialogs.... and match them..." - dialog := initial_dialog newFromRequest: aReq. + ^ true + ] + + stopRetransmitTimer [ + + "I stop the retransmit timers, e.g. because there was a request, + or there was a timeout, or someone canceled things." sem critical: [ retransmit_time cancel. fail_time cancel. - ]. + ] + ] - code := aReq code asInteger. + newData: aResp [ + | dialog | + + + ('Found response %1 %2' % {aResp code. aResp phrase}) printNl. + + (self checkSequenceNumber: aResp) ifFalse: [^ false]. + + "Store all dialogs.... and match them..." + dialog := initial_dialog newFromRequest: aResp. + + self stopRetransmitTimer. + self dispatchDialog: dialog response: aResp. + ] + + dispatchDialog: dialog response: aResp [ + | code | + + + code := aResp code asInteger. code < 200 ifTrue: [ - ^ self respNotification: aReq dialog: dialog + ^ self respNotification: aResp dialog: dialog ]. code = 200 ifTrue: [ - ^ self respSuccess: aReq dialog: dialog + ^ self respSuccess: aResp dialog: dialog ]. code > 200 ifTrue: [ - ^ self respFailure: aReq dialog: dialog + ^ self respFailure: aResp dialog: dialog ] ] @@ -251,14 +275,14 @@ Object subclass: SIPTransaction [ ^ ack ] - createBye [ + createBye: aDialog [ | bye | - bye := (SIPByeRequest from: initial_dialog) + bye := (SIPByeRequest from: aDialog) addParameter: 'Via' value: (useragent generateVia: branch); addParameter: 'CSeq' value: '%1 %2' % {cseq. 'BYE'}; - addParameter: 'Call-ID' value: initial_dialog callId; + addParameter: 'Call-ID' value: aDialog callId; yourself. useragent injectDefaults: bye. ^ bye @@ -304,24 +328,107 @@ SIPTransaction subclass: SIPInviteTransaction [ self queueData: invite asDatagram dialog: initial_dialog. ] + dispatchDialog: aDialog response: aResponse [ + | cseq | + + "The INVITE transaction is a bit more complicated. It is the only + transaction that can be canceled and we will need to do some things + to check if this is canceled. We have some indirections here + 1.) we get a 200 for a BYE/CANCEL in the CSeq + 2.) we get a reply but we should cancel, e.g. we were waiting for + a proceeding/notification or the call is too far in the setup + and we will just bye it. + 3.) the normal dispatch..." + + cseq := aResponse parameter: 'CSeq' ifAbsent: []. + cseq method = 'INVITE' + ifTrue: [self dispatchInvite: aDialog response: aResponse] + ifFalse: [self dispatchOther: aDialog response: aResponse]. + ] + + dispatchOther: aDialog response: aResponse [ + | cseq code | + + + code := aResponse code asInteger. + cseq := aResponse parameter: 'CSeq' ifAbsent: []. + + code = 200 ifTrue: [ + self removeTransaction. + self queueData: (self createAck: branch dialog: aDialog) asDatagram + dialog: aDialog. + ]. + ] + + handleCancel: aDialog response: aResponse [ + | code | + + code := aResponse code asInteger. + + "We will send a CANCEL, maybe it is already the second." + code < 200 ifTrue: [ + self queueData: (self createCancel asDatagram) dialog: initial_dialog. + ]. + + "We are connected but we didn't want to, let us BYE it" + (code = 200 or: [(code > 200 and: [code ~= 487])]) ifTrue: [ + | bye branch | + branch := useragent class generateBranch. + self removeTransaction. + self queueData: (self createAck: branch dialog: aDialog) asDatagram + dialog: aDialog. + bye := SIPByeTransaction + createWith: aDialog on: useragent cseq: cseq + 1. + bye start. + ]. + ] + + dispatchInvite: aDialog response: aResponse [ + + "Send a cancel if this is a non final response" + canceled + ifTrue: [self handleCancel: aDialog response: aResponse] + ifFalse: [super dispatchDialog: aDialog response: aResponse]. + ] + respSuccess: aReq dialog: aDialog [ | branch | + + branch := useragent class generateBranch. self changeState: self class stateTerminated. - "TODO: We probably want to accept and then release/BYE it" - (super respSuccess: aReq dialog: aDialog) ifTrue: [ - self queueData: (self createAck: branch dialog: aDialog) asDatagram - dialog: aDialog. + "We send the ACK, if our callbacks don't like the result we + will need to send a BYE to stop that session." + self queueData: (self createAck: branch dialog: aDialog) asDatagram dialog: aDialog. + (super respSuccess: aReq dialog: aDialog) ifFalse: [| bye | + bye := SIPByeTransaction + createWith: aDialog on: useragent cseq: cseq + 1. + bye start. ] ] respFailure: aReq dialog: aDialog [ + self changeState: self class stateCompleted. self queueData: (self createAck: branch dialog: aDialog) asDatagram dialog: aDialog. ^ super respFailure: aReq dialog: aDialog. ] + + cancel [ + + canceled := true. + self stopRetransmitTimer. + self changeState: self class stateCanceled. + + self state = self class stateProceeding ifTrue: [ + self queueData: self createCancel asDatagram dialog: initial_dialog. + ]. + self state = self class stateCompleted ifTrue: [ + self logError: 'SIPTransaction already completed.' area: #sip. + ]. + ] ] SIPTransaction subclass: SIPByeTransaction [ @@ -329,7 +436,7 @@ SIPTransaction subclass: SIPByeTransaction [ transmit [ | bye | - bye := self createBye. + bye := self createBye: initial_dialog. self queueData: bye asDatagram dialog: initial_dialog. ] ]