From 587c1c368331c495cb05d4aaa2799daa5453b578 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Sun, 2 Dec 2012 00:14:57 +0100 Subject: [PATCH] auth: Introduce an authenticator that asks for the IMSI --- package.xml | 1 + src/GSMAuthenticator.st | 71 ++++++++++++++++++++++++ src/GSMProcessor.st | 11 +++- tests/AuthTest.st | 116 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 197 insertions(+), 2 deletions(-) diff --git a/package.xml b/package.xml index f707473..d9bb8c7 100644 --- a/package.xml +++ b/package.xml @@ -27,6 +27,7 @@ OsmoMSC.MSCBSCConnectionHandlerTest OsmoMSC.BSCIPAConnectionTest OsmoMSC.AuthTestNull + OsmoMSC.AuthTestIdentity tests/Test.st tests/AuthTest.st diff --git a/src/GSMAuthenticator.st b/src/GSMAuthenticator.st index a151258..7b839ab 100644 --- a/src/GSMAuthenticator.st +++ b/src/GSMAuthenticator.st @@ -31,6 +31,11 @@ Object subclass: GSMAuthenticatorBase [ connection := aCon. ] + connection [ + + ^ connection + ] + onAccept: aBlock [ "Called when the connection is accepted" @@ -60,6 +65,11 @@ Object subclass: GSMAuthenticatorBase [ "The GSM Connection has failed cancel everything." ^ self subclassResponsibility ] + + nextPut: aMsg [ + connection nextPutData: (OsmoGSM.BSSAPDTAP initWith: aMsg + linkIdentifier: 0). + ] ] GSMAuthenticatorBase subclass: GSMNullAuthenticator [ @@ -78,3 +88,64 @@ GSMAuthenticatorBase subclass: GSMNullAuthenticator [ "Nothing" ] ] + +GSMAuthenticatorBase subclass: GSMIdentityAuthenticator [ + | state timeout | + + + + + cancel [ + "Cancel all timers" + timeout ifNotNil: [timeout cancel. timeout := nil]. + ] + + start: aMsg [ + "TODO we could take the IMSI from the first message but this + is mostly for educational purpose." + self askForIMSI. + ] + + askForIMSI [ + | req | + + timeout := Osmo.TimerScheduler instance + scheduleInSeconds: 5 block: [self timeOut]. + + "I ask for the IMSI." + req := GSM48IdentityReq new. + req idType type: GSM48IdentityType typeIMSI. + state := #askForIMSI:. + self nextPut: req toMessage. + ] + + askForIMSI: aIdResponse [ + connection + addInfo: 'IMSI' + value: aIdResponse mi imsi. + self logNotice: 'GSMIdentityAuthenticator(srcref:%1) got IMSI(%2).' + % {connection srcRef. aIdResponse mi imsi} area: #bsc. + timeout cancel. + onAccept value: self. + ] + + onData: aMsg [ + [ + self perform: state with: aMsg. + ] on: Exception do: [:e | + e logException: 'GSMIdentityAuthenticator(srcref:%1) failed dispatch.' + % {connection srcRef} area: #bsc. + timeout cancel. + onReject value: self. + ]. + ] + + timeOut [ + self logError: 'GSMIdentityAuthenticator(srcref:%1) no reply to %2' + % {connection srcRef. state} area: #bsc. + state := #timedout:. + connection takeLocks: [onReject value: self]. + ] +] diff --git a/src/GSMProcessor.st b/src/GSMProcessor.st index 4355971..9a306af 100644 --- a/src/GSMProcessor.st +++ b/src/GSMProcessor.st @@ -127,7 +127,7 @@ GSM transaction on a given SAPI'> ] OsmoGSM.SCCPConnectionBase subclass: GSMProcessor [ - | transactions state endp connId mgcp_trans auth pending | + | transactions state endp connId mgcp_trans auth pending info | GSMProcessor class >> authenticator [ - ^ GSMNullAuthenticator + ^ GSMIdentityAuthenticator ] GSMProcessor class >> createAssignment: aMul timeslot: aTs [ @@ -164,9 +164,16 @@ hosting various transactions and dispatching to them.'> transactions := OrderedCollection new. state := self class stateInitial. + info := Dictionary new. ^ super initialize. ] + addInfo: aKey value: aValue [ + + "Store additional info about this call here." + info at: aKey put: aValue. + ] + data: aData [ | msg bssmap data | diff --git a/tests/AuthTest.st b/tests/AuthTest.st index fcf2ac6..b173a93 100644 --- a/tests/AuthTest.st +++ b/tests/AuthTest.st @@ -30,3 +30,119 @@ TestCase subclass: AuthTestNull [ self assert: accepted. ] ] + +Object subclass: GSMProcessorMockBase [ + | auth dict | + + GSMProcessorMockBase class >> initWith: anAuth [ + ^ self new + instVarNamed: #auth put: anAuth; + instVarNamed: #dict put: Dictionary new; + yourself. + ] + + addInfo: aName value: aValue [ + dict at: aName put: aValue. + ] + + getInfo: aName [ + ^ dict at: aName + ] + + srcRef [ + ^ 1 + ] + + takeLocks: aBlock [ + aBlock value + ] +] + +GSMProcessorMockBase subclass: GSMProcessorMockForAuthCheat [ + nextPutData: aData [ + "Ignore the data for now. Should be a identity request" + OsmoDispatcher dispatchBlock: [ + | msg | + + "Reply with a wrong identity response" + msg := OsmoGSM.GSM48IdentityResponse new. + msg mi imei: '234324234234'. + auth onData: msg.] + ] +] + +GSMProcessorMockBase subclass: GSMProcessorMockForAuthIMSI [ + usedIMSI [ + ^ '234324234234' + ] + + nextPutData: aData [ + "Ignore the data for now. Should be a identity request" + OsmoDispatcher dispatchBlock: [ + | msg | + + "Reply with a wrong identity response" + msg := OsmoGSM.GSM48IdentityResponse new. + msg mi imsi: self usedIMSI. + auth onData: msg.] + ] +] + +GSMProcessorMockBase subclass: GSMProcessorMockForAuthTimeout [ + nextPutData: aData [ + "Do nothing" + ] +] + +TestCase subclass: AuthTestIdentity [ + + + testWrongResponse [ + | auth rejected wait | + + Transcript nextPutAll: 'Going to send a wrong response leading to an exception.'; nl. + + wait := Semaphore new. + auth := GSMIdentityAuthenticator new + onAccept: [:a | ^self error: 'This should not be accepted']; + onReject: [:a | self assert: a = auth. rejected := true. wait signal]; + yourself. + auth + connection: (GSMProcessorMockForAuthCheat initWith: auth); + start: nil. + + wait wait. + self assert: rejected. + ] + + testTimeout [ + | auth rejected wait | + wait := Semaphore new. + auth := GSMIdentityAuthenticator new + onAccept: [:a | ^self error: 'This should not be accepted']; + onReject: [:a | self assert: a = auth. rejected := true. wait signal]; + yourself. + auth + connection: (GSMProcessorMockForAuthTimeout initWith: auth); + start: nil. + + wait wait. + self assert: rejected. + ] + + testIMSI [ + | auth accept wait | + wait := Semaphore new. + auth := GSMIdentityAuthenticator new + onAccept: [:a | self assert: a = auth. accept := true. wait signal]; + onReject: [:a | ^self error: 'This should not be rejected']; + yourself. + auth + connection: (GSMProcessorMockForAuthIMSI initWith: auth); + start: nil. + + wait wait. + self assert: accept. + self assert: (auth connection getInfo: 'IMSI') = auth connection usedIMSI. + ] +]