From 259976e68a21b67c0b648ce5c77fc94aacb517ac Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Sun, 28 Oct 2012 10:36:06 +0100 Subject: [PATCH] gsm: Introduce the concept of an authenticator for a channel The role of the authenticator is to collect information about the subscriber and allow the GSMProcessor to accept the service, enable encryptionor whatever is needed. --- src/GSMAuthenticator.st | 78 ++++++++++++++++++++++++++++++++++++ src/GSMProcessor.st | 87 ++++++++++++++++++++++++++++++++++++----- 2 files changed, 156 insertions(+), 9 deletions(-) create mode 100644 src/GSMAuthenticator.st diff --git a/src/GSMAuthenticator.st b/src/GSMAuthenticator.st new file mode 100644 index 0000000..6dc029a --- /dev/null +++ b/src/GSMAuthenticator.st @@ -0,0 +1,78 @@ +" + (C) 2010-2012 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: GSMAuthenticatorBase [ + | connection onAccept onReject | + + + + connection: aCon [ + + connection := aCon. + ] + + onAccept: aBlock [ + + "Called when the connection is accepted" + onAccept := aBlock + ] + + onReject: aBlock [ + + "Called when the connection is rejected" + onReject := aBlock + ] + + start: aMsg [ + + "Start authentication with the initial message." + ^ self subclassResponsibility + ] + + onData: aMsg [ + + "Called with data from the GSM connection" + ^ self subclassResponsibility + ] + + cancel [ + + "The GSM Connection has failed cancel everything." + ^ self subclassResponsibility + ] +] + +GSMAuthenticatorBase subclass: GSMNullAuthenticator [ + + + + start: aMsg [ + onAccept value: self. + ] + + onData: aMsg [ + ^ self shouldNotImplement + ] + + cancel [ + "Nothing" + ] +] diff --git a/src/GSMProcessor.st b/src/GSMProcessor.st index 8a51eb7..16bc7b2 100644 --- a/src/GSMProcessor.st +++ b/src/GSMProcessor.st @@ -1,5 +1,5 @@ " - (C) 2010-2011 by Holger Hans Peter Freyther + (C) 2010-2012 by Holger Hans Peter Freyther All Rights Reserved This program is free software: you can redistribute it and/or modify @@ -127,7 +127,7 @@ GSM transaction on a given SAPI'> ] OsmoGSM.SCCPConnectionBase subclass: GSMProcessor [ - | transactions state endp connId mgcp_trans | + | transactions state endp connId mgcp_trans auth pending | GSMProcessor class >> stateInitial [ ^ 0 ] GSMProcessor class >> stateAcked [ ^ 1 ] - GSMProcessor class >> stateRelease [ ^ 2 ] - GSMProcessor class >> stateError [ ^ 3 ] + GSMProcessor class >> stateAuth [ ^ 2 ] + GSMProcessor class >> stateRelease [ ^ 3 ] + GSMProcessor class >> stateError [ ^ 4 ] + + GSMProcessor class >> authenticator [ + + ^ GSMNullAuthenticator + ] GSMProcessor class >> createAssignment: aMul timeslot: aTs [ | ass | @@ -218,9 +224,11 @@ hosting various transactions and dispatching to them.'> mapClearCompl: aData [ sem critical: [ - self verifyState: [state = self class stateRelease]. - self releaseAudio. - self release. + self + verifyState: [state = self class stateRelease]; + releaseAudio; + releaseAuth; + release. ]. ] @@ -242,7 +250,9 @@ hosting various transactions and dispatching to them.'> ]. transactions := OrderedCollection new. - self releaseAudio. + self + releaseAudio; + releaseAuth. ]. ] @@ -300,7 +310,31 @@ hosting various transactions and dispatching to them.'> openTransaction: aTran with: aMsg [ self addTransaction: aTran. - aTran start: aMsg. + + "The authentication has happend, just start the transaction." + self state = self class stateAuth ifTrue: [ + ^ aTran start: aMsg + ]. + + "An authentication is pending." + auth isNil ifFalse: [ + self logNotice: 'GSMProc(srcref:%1) auth pending.' + % {self srcRef} area: #bsc. + pending add: (aTran -> aMsg). + ^ true. + ]. + + "Remember to launch this transaction" + pending := OrderedCollection new + add: (aTran -> aMsg); + yourself. + + auth := self class authenticator new + connection: self; + onAccept: [:auth | self takeLocks: [ self authenticationAccepted]]; + onReject: [:auth | self takeLocks: [ self authenticationRejected]]; + yourself. + auth start. ] addTransaction: aTran [ @@ -331,6 +365,11 @@ hosting various transactions and dispatching to them.'> "Must be locked" + "Pass everything to the authenticator if present." + auth isNil ifFalse: [ + ^ auth onData: aMsg. + ]. + "Find an active transaction for this" transactions do: [:each | (each sapi = aSapi and: [each ti = aMsg ti]) ifTrue: [ @@ -397,6 +436,16 @@ hosting various transactions and dispatching to them.'> selectAudioRoute: self plan: aPlan leg: aLeg ] + releaseAuth [ + + auth isNil + ifTrue: [^true]. + + "Give up on the authentication." + auth cancel. + auth := nil. + ] + releaseAudio [ "I try to release things right now." @@ -654,4 +703,24 @@ hosting various transactions and dispatching to them.'> mdcxTimeout: aTimeout [ ] + + authenticationAccepted [ + + "Must be locked" + auth := nil. + pending do: [:each | + each key start: each value]. + pending := nil. + ] + + authenticationRejected [ + + "Must be locked" + + "TODO" + "Send a CM Service Request to the phone" + + "Close down the connection. FIXME: use a better error value" + self clearCommand: 0. + ] ]