From 44da7d743facc4571f951bde7aba3dfe91356d46 Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Wed, 14 Aug 2019 13:28:08 +0200 Subject: [PATCH] WIP --- dia/diameter_3gpp_ts29_173.dia | 11 +- dia/diameter_3gpp_ts29_272.dia | 2 +- rebar.config | 6 +- src/osmo_dia2gsup.app.src | 2 +- src/osmo_dia2gsup.erl | 18 ++- src/osmo_dia2gsup_app.erl | 9 +- src/osmo_dia2gsup_sup.erl | 17 +++ src/server_cb.erl | 195 ++++++++++++++++++++++++++++++++- 8 files changed, 229 insertions(+), 31 deletions(-) create mode 100644 src/osmo_dia2gsup_sup.erl diff --git a/dia/diameter_3gpp_ts29_173.dia b/dia/diameter_3gpp_ts29_173.dia index 8da3354..43960a7 100644 --- a/dia/diameter_3gpp_ts29_173.dia +++ b/dia/diameter_3gpp_ts29_173.dia @@ -27,24 +27,15 @@ @id 16777291 @name diameter_3gpp_ts29_173 -@prefix diameter_aaa +;;@prefix diameter_3gpp @vendor 10415 3GPP @inherits diameter_gen_base_rfc6733 -;; @inherits diameter_rfc4005_nasreq -;; @inherits diameter_rfc4006_cc @inherits diameter_3gpp_base -;; @inherits diameter_etsi_es283_034 -;; @inherits diameter_3gpp_ts29_061_gmb -;; @inherits diameter_3gpp_ts29_214 @inherits diameter_3gpp_ts29_229 @inherits diameter_3gpp_ts29_329 @inherits diameter_3gpp_break_circles -;;@inherits diameter_rfc5447 -;;@inherits diameter_rfc5778 -;;@inherits diameter_3gpp_ts29_272 - @avp_types 3GPP-AAA-Server-Name 318 DiameterIdentity MV ;; from 29.273 diff --git a/dia/diameter_3gpp_ts29_272.dia b/dia/diameter_3gpp_ts29_272.dia index 24fe63f..f0c6d6a 100644 --- a/dia/diameter_3gpp_ts29_272.dia +++ b/dia/diameter_3gpp_ts29_272.dia @@ -27,7 +27,7 @@ @id 16777251 @name diameter_3gpp_ts29_272 -@prefix diameter_aaa +;;@prefix diameter_3gpp @vendor 10415 3GPP @inherits diameter_gen_base_rfc6733 diff --git a/rebar.config b/rebar.config index 24ec03c..86444dd 100644 --- a/rebar.config +++ b/rebar.config @@ -2,7 +2,9 @@ {deps, [ {setup, "2.0.2"}, - {lager, "3.6.8"} + {lager, "3.6.8"}, + {osmo_ss7, {git, "git://git.osmocom.org/erlang/osmo_ss7", {branch, "laforge/wip"}}}, + {osmo_gsup, {git, "git://git.osmocom.org/erlang/osmo_gsup", {branch, "master"}}} ]}. {minimum_otp_vsn, "20.3"}. @@ -21,8 +23,6 @@ ]} ]}. -{dia_first_files, ["diameter_3gpp_base.dia", "diameter_rfc7155_nasreq.dia", "diameter_3gpp_ts29_212.dia", "diameter_3gpp_ts32_299.dia", "diameter_3gpp_ts29_272.dia"]}. - {dia_opts, []}. {dialyzer, [ diff --git a/src/osmo_dia2gsup.app.src b/src/osmo_dia2gsup.app.src index 97c1cb6..514ea59 100644 --- a/src/osmo_dia2gsup.app.src +++ b/src/osmo_dia2gsup.app.src @@ -1,5 +1,5 @@ {application, osmo_dia2gsup, [ - {decription, "Osmocom DIAMETER -> GSUP translator"}, + {description, "Osmocom DIAMETER -> GSUP translator"}, {vsn, "1"}, {registered, []}, {applications, [ diff --git a/src/osmo_dia2gsup.erl b/src/osmo_dia2gsup.erl index a064a99..b616586 100644 --- a/src/osmo_dia2gsup.erl +++ b/src/osmo_dia2gsup.erl @@ -25,11 +25,13 @@ -define(CALLBACK_MOD, server_cb). -define(DIAMETER_DICT_HSS, diameter_3gpp_ts29_272). +-define(APPID_S6, #'diameter_base_Vendor-Specific-Application-Id'{'Vendor-Id'=10515, 'Auth-Application-Id'=[16777251]}). -define(SERVICE(Name), [{'Origin-Host', application:get_env(osmo_dia2gsup, origin_host, "hss.localdomain")}, - {'Origin-Realm', applicaiton:get_env(osmo_dia2gsup, origin_realm, "localdomain")}, + {'Origin-Realm', application:get_env(osmo_dia2gsup, origin_realm, "localdomain")}, {'Vendor-Id', application:get_env(osmo_dia2gsup, vendor_id, 0)}, {'Product-Name', "osmo_dia2gsup"}, {'Auth-Application-Id', []}, + {'Vendor-Specific-Application-Id', [?APPID_S6]}, {application, [{alias, ?APP_ALIAS}, {dictionary, ?DIAMETER_DICT_HSS}, @@ -46,7 +48,7 @@ start_link() -> gen_server:start_link({local, ?SERVER}, ?MODULE, [], []). start() -> - application:sensure_all_started(?MODULE), + application:ensure_all_started(?MODULE), start_link(). stop() -> @@ -58,13 +60,19 @@ stop() -> %% @callback gen_server init(State) -> + % DIAMETER side SvcName = ?MODULE, diameter:start_service(SvcName, ?SERVICE(SvcName)), - Ip = application:get_env(osmo_dia2gsup, diameter_ip, "127.0.0.1"), + Ip = application:get_env(osmo_dia2gsup, diameter_ip, "127.0.0.4"), Port = application:get_env(osmo_dia2gsup, diameter_port, 3868), - Proto = applicaiton:get_env(osmo_dia2gsup, diameter_proto, sctp), + Proto = application:get_env(osmo_dia2gsup, diameter_proto, sctp), listen({address, Proto, element(2,inet:parse_address(Ip)), Port}), lager:info("Diameter HSS Application started on IP ~s, ~p port ~p~n", [Ip, Proto, Port]), + % GSUP side + HlrIp = application:get_env(osmo_dia2gsup, hlr_ip, "127.0.0.1"), + HlrPort = application:get_env(osmo_dia2gsup, hlr_port, 4222), + lager:info("Connecting to GSUP HLR on IP ~s port ~p~n", [HlrIp, HlrPort]), + {ok, _Pid} = gen_server:start_link({local, gsup_client}, gsup_client, [HlrIp, HlrPort, []], [{debug, [trace]}]), {ok, State}. %% @callback gen_server @@ -108,7 +116,7 @@ listen(Name, {address, Protocol, IPAddr, Port}) -> TransOpts = [{transport_module, tmod(Protocol)}, {transport_config, [{reuseaddr, true}, {ip, IPAddr}, {port, Port}]}], - diameter:add_transport(Name, {listen, TransOpts}). + {ok, _} = diameter:add_transport(Name, {listen, TransOpts}). listen(Address) -> listen(?SVC_NAME, Address). diff --git a/src/osmo_dia2gsup_app.erl b/src/osmo_dia2gsup_app.erl index e22bad9..c05cd3c 100644 --- a/src/osmo_dia2gsup_app.erl +++ b/src/osmo_dia2gsup_app.erl @@ -4,14 +4,7 @@ -export([start/2, stop/1]). start(_StartType, _StartArgs) -> - case somo_dia2gsup_sup:start_link() of - {ok, _} = Net -> - osmo_dia2gsup_sup:start_childs(SrvSupSpecs), - ret; - Other -> - Other - end. + osmo_dia2gsup_sup:start_link(). stop(_State) -> ok. - diff --git a/src/osmo_dia2gsup_sup.erl b/src/osmo_dia2gsup_sup.erl new file mode 100644 index 0000000..eab41b8 --- /dev/null +++ b/src/osmo_dia2gsup_sup.erl @@ -0,0 +1,17 @@ +-module(osmo_dia2gsup_sup). +-behaviour(supervisor). + +-export([start_link/0]). +-export([init/1]). + +-define(SERVER, ?MODULE). +start_link() -> + supervisor:start_link({local, ?SERVER}, ?MODULE, []). + +init([]) -> + DiaServer = {osmo_dia2gsup,{osmo_dia2gsup,start_link,[]}, + permanent, + 5000, + worker, + [server_cb]}, + {ok, { {one_for_one, 5, 10}, [DiaServer]} }. diff --git a/src/server_cb.erl b/src/server_cb.erl index 2256f5b..c9a14f0 100644 --- a/src/server_cb.erl +++ b/src/server_cb.erl @@ -4,7 +4,7 @@ -include_lib("diameter/include/diameter.hrl"). -include_lib("diameter/include/diameter_gen_base_rfc6733.hrl"). -include_lib("diameter_3gpp_ts29_272.hrl"). -%-include_lib("diameter_settings.hrl"). +-include_lib("osmo_gsup/include/gsup_protocol.hrl"). %% diameter callbacks @@ -37,6 +37,195 @@ handle_error(_Reason, _Request, _SvcName, _Peer) -> lager:error("Request error: ~p~n", [_Reason]), ?UNEXPECTED. -handle_request(#diameter_packet{}, _SvcName, {_,_}) -> - lager:error("Unsuppoerted message.~n"), +% generate Diameter E-UTRAN / UTRAN / GERAN Vectors from GSUP tuple input +-spec gsup_tuple2dia_eutran('GSUPAuthTuple'(), binary(), integer()) -> #'E-UTRAN-Vector'{}. +gsup_tuple2dia_eutran(#{autn:=Autn, ck:=Ck, ik:=Ik, rand:=Rand, res:=Res}, Vplmn, Idx) -> + #'E-UTRAN-Vector'{'Item-Number'=Idx, 'RAND'=Rand, 'XRES'=Res , 'AUTN'=Autn, + 'KASME'=compute_kasme(Ck, Ik, Vplmn, Autn)}. + +-spec gsup_tuple2dia_utran('GSUPAuthTuple'()) -> #'UTRAN-Vector'{}. +gsup_tuple2dia_utran(#{autn:=Autn, ck:=Ck, ik:=Ik, rand:=Rand, res:=Res}) -> + #'UTRAN-Vector'{'RAND'=Rand, 'XRES'=Res, 'AUTN'=Autn, 'Confidentiality-Key'=Ck, 'Integrity-Key'=Ik}. + +-spec gsup_tuple2dia_geran('GSUPAuthTuple'()) -> #'GERAN-Vector'{}. +gsup_tuple2dia_geran(#{rand:=Rand, sres:=Sres, kc:=Kc}) -> + #'GERAN-Vector'{'RAND'=Rand, 'SRES'=Sres, 'Kc'=Kc}. + +-spec gsup_tuples2dia_eutran(['GSUPAuthTuple'()], binary()) -> [#'E-UTRAN-Vector'{}]. +gsup_tuples2dia_eutran(List, Vplmn) -> gsup_tuples2dia_eutran(List, Vplmn, [], 1). +gsup_tuples2dia_eutran([], _Vplmn, Out, _Idx) -> Out; +gsup_tuples2dia_eutran([Head|Tail], Vplmn, Out, Ctr) -> + Dia = gsup_tuple2dia_eutran(Head, Vplmn, Ctr), + gsup_tuples2dia_eutran(Tail, Vplmn, [Dia|Out], Ctr+1). + +-type int_or_false() :: false | integer(). +-spec gsup_tuples2dia(['GSUPAuthTuple'()], binary(), int_or_false(), int_or_false(), int_or_false()) -> #'Authentication-Info'{}. +gsup_tuples2dia(Tuples, Vplmn, NumEutran, NumUtran, NumGeran) -> + case NumEutran of + false -> EutranVecs = []; + 0 -> EutranVecs = []; + _ -> EutranVecs = gsup_tuples2dia_eutran(lists:sublist(Tuples,NumEutran), Vplmn) + end, + case NumUtran of + false -> UtranVecs = []; + 0 -> UtranVecs = []; + _ -> UtranVecs = lists:map(fun gsup_tuple2dia_utran/1, lists:sublist(Tuples,NumUtran)) + end, + case NumGeran of + false -> GeranVecs = []; + 0 -> GeranVecs = []; + _ -> GeranVecs = lists:map(fun gsup_tuple2dia_geran/1, lists:sublist(Tuples,NumGeran)) + end, + #'Authentication-Info'{'E-UTRAN-Vector'=EutranVecs, 'UTRAN-Vector'=UtranVecs, + 'GERAN-Vector'=GeranVecs}. + + +-spec compute_kasme(<<_:16>>, <<_:16>>, <<_:3>>, <<_:16>>) -> <<_:32>>. +compute_kasme(Ck, Ik, VplmnId, Autn) -> + Autn6 = binary_part(Autn, 0, 6), + K = <>, + S = <<16, VplmnId:3/binary, 0, 3, Autn6:6/binary, 0, 6>>, + crypto:hmac(sha256, K, S, 32). + +-spec req_num_of_vec([tuple()]) -> int_or_false(). +req_num_of_vec([#'Requested-EUTRAN-Authentication-Info'{'Number-Of-Requested-Vectors'=[]}]) -> false; +req_num_of_vec([#'Requested-EUTRAN-Authentication-Info'{'Number-Of-Requested-Vectors'=[Num]}]) -> Num; +req_num_of_vec([#'Requested-UTRAN-GERAN-Authentication-Info'{'Number-Of-Requested-Vectors'=[]}]) -> false; +req_num_of_vec([#'Requested-UTRAN-GERAN-Authentication-Info'{'Number-Of-Requested-Vectors'=[Num]}]) -> Num; +req_num_of_vec(_) -> false. + +-spec gsup_pdp2dia('GSUPPdpInfo'()) -> #'PDP-Context'{}. +gsup_pdp2dia(GsupPdpInfo) -> + #'PDP-Context'{'PDP-Type' = maps:get(pdp_type, GsupPdpInfo), + 'Context-Identifier' = maps:get(pdp_context_id, GsupPdpInfo), + 'PDP-Address' = maps:get(access_point_name, GsupPdpInfo), + 'Service-Selection' = fixme, + 'QoS-Subscribed' = maps:get(quality_of_service, GsupPdpInfo) + }. + +% transient (only in Experimental-Result-Code) +-define(DIAMETER_AUTHENTICATION_DATA_UNAVAILABLE, 4181). +-define(DIAMETER_ERROR_CAMEL_SUBSCRIPTION_PRESENT, 4182). +% permanent (only in Experimental-Result-Code) +-define(DIAMETER_ERROR_USER_UNKNOWN, 5001). +-define(DIAMETER_ERROR_ROAMING_NOT_ALLOWED, 5004). +-define(DIAMETER_ERROR_UNKNOWN_EPS_SUBSCRIPTION, 5420). +-define(DIAMETER_ERROR_RAT_NOT_ALLOWED, 5421). +-define(DIAMETER_ERROR_EQUIPMENT_UNKNOWN, 5422). +-define(DIAMETER_ERROR_UNKOWN_SERVING_NODE, 5423). + +% 10.5.5.14 +-define(GMM_CAUSE_IMSI_UNKNOWN, 16#02). +-define(GMM_CAUSE_PLMN_NOTALLOWED, 16#0b). +-define(GMM_CAUSE_GPRS_NOTALLOWED, 16#07). +-define(GMM_CAUSE_INV_MAND_INFO, 16#60). +-define(GMM_CAUSE_NET_FAIL, 16#11). +% TODO: more values + +-define(EXP_RES(Foo), #'Experimental-Result'{'Vendor-Id'=fixme, 'Experimental-Result-Code'=Foo}). + +-type empty_or_intl() :: [] | [integer()]. +-spec gsup_cause2dia(integer()) -> {empty_or_intl(), empty_or_intl()}. +gsup_cause2dia(?GMM_CAUSE_IMSI_UNKNOWN) -> {[], [?EXP_RES(?DIAMETER_ERROR_USER_UNKNOWN)]}; +gsup_cause2dia(?GMM_CAUSE_PLMN_NOTALLOWED) -> {[], [?DIAMETER_ERROR_ROAMING_NOT_ALLOWED]}; +gsup_cause2dia(?GMM_CAUSE_GPRS_NOTALLOWED) -> {[], [?DIAMETER_ERROR_RAT_NOT_ALLOWED]}; +%gsup_cause2dia(?GMM_CAUSE_INV_MAND_INFO) -> +%gsup_cause2dia(?GMM_CAUSE_NET_FAIL) -> +% TODO: more values +gsup_cause2dia(_) -> {fixme, []}. + +% get the value for a tiven key in Map1. If not found, try same key in Map2. If not found, return Default +-spec twomap_get(atom(), map(), map(), any()) -> any(). +twomap_get(Key, Map1, Map2, Default) -> + maps:get(Key, Map1, maps:get(Key, Map2, Default)). + +handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps}) when is_record(Req, 'AIR') -> + lager:info("AIR: ~p~n", [Req]), + % extract relevant fields from DIAMETER AIR + #diameter_caps{origin_host = {OH,_}, origin_realm = {OR,_}} = Caps, + #'AIR'{'Session-Id' = SessionId, + 'User-Name' = UserName, + 'Visited-PLMN-Id' = VplmnId, + 'Requested-EUTRAN-Authentication-Info' = ReqEU, + 'Requested-UTRAN-GERAN-Authentication-Info' = ReqUG} = Req, + VplmnIdBin = list_to_binary(VplmnId), + NumEutran = req_num_of_vec(ReqEU), + NumUgran = req_num_of_vec(ReqUG), + lager:info("Num EUTRAN=~p, UTRAN=~p~n", [NumEutran, NumUgran]), + % construct GSUP request to HLR and transceive it + GsupTx = #{message_type => send_auth_info_req, imsi => list_to_binary(UserName)}, + GsupRx = gen_server:call(gsup_client, {transceive_gsup, GsupTx, send_auth_info_res, send_auth_info_err}), + lager:info("GsupRx: ~p~n", [GsupRx]), + % construct DIAMETER AIA response + case GsupRx of + #{message_type:=send_auth_info_res, auth_tuples:=GsupAuthTuples} -> + AuthInfo = gsup_tuples2dia(GsupAuthTuples, VplmnIdBin, NumEutran, NumUgran, NumUgran), + Resp = #'AIA'{'Session-Id'=SessionId, 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=2001, 'Auth-Session-State'=1, + 'Authentication-Info'=AuthInfo}; + #{message_type := send_auth_info_err} -> + Resp = #'AIA'{'Session-Id'=SessionId, 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=?DIAMETER_ERROR_USER_UNKNOWN, + 'Auth-Session-State'=1}; + timeout -> + Resp = #'AIA'{'Session-Id'=SessionId, 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=4181, 'Auth-Session-State'=1} + end, + lager:info("Resp: ~p~n", [Resp]), + {reply, Resp}; + +handle_request(#diameter_packet{msg = Req, errors = []}, _SvcName, {_, Caps}) when is_record(Req, 'ULR') -> + % extract relevant fields from DIAMETER AIR + #diameter_caps{origin_host = {OH,_}, origin_realm = {OR,_}} = Caps, + #'ULR'{'Session-Id' = SessionId, + 'RAT-Type' = RatType, + 'ULR-Flags' = UlrFlags, + 'User-Name' = UserName} = Req, + + % construct GSUP UpdateLocation request to HLR and transceive it; expect InsertSubscrDataReq + GsupTxUlReq = #{message_type => location_upd_req, cn_domain => fixme}, + GsupRxIsdReq = gen_server:call(gsup_client, + {transceive_gsup, GsupTxUlReq, insert_sub_data_req, location_upd_err}), + lager:info("GsupRxIsdReq: ~p~n", [GsupRxIsdReq]), + case GsupRxIsdReq of + #{message_type:=location_upd_err, cause:=Cause} -> + {Res, ExpRes} = gsup_cause2dia(Cause), + Resp = #'ULA'{'Session-Id'= SessionId, 'Auth-Session-State'=1, + 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=Res, 'Experimental-Result'=ExpRes}; + #{message_type:=insert_sub_data_req} -> + % construct GSUP InsertSubscrData response to HLR and transceive it; expect + % UpdateLocationRes + GsupTxIsdRes = #{message_type => insert_sub_data_res}, + GsupRxUlRes = gen_server:call(gsup_client, + {transceive_gsup, GsupTxIsdRes, location_upd_res, location_upd_err}), + lager:info("GsupRxUlRes: ~p~n", [GsupRxUlRes]), + + case GsupRxUlRes of + #{message_type:=location_upd_res} -> + Msisdn = twomap_get(msisdn, GsupRxIsdReq, GsupRxUlRes, []), + Compl = twomap_get(pdp_info_complete, GsupRxIsdReq, GsupRxUlRes, []), + PdpInfoList = twomap_get(pdp_info_list, GsupRxIsdReq, GsupRxUlRes, []), + PdpContexts = gsup_pdp2dia(PdpInfoList), + GSubD = #'GPRS-Subscription-Data'{'Complete-Data-List-Included-Indicator'=[Compl], + 'PDP-Context'=PdpContexts}, + SubscrData = #'Subscription-Data'{'MSISDN'=Msisdn,'GPRS-Subscription-Data'=GSubD}, + Resp = #'ULA'{'Session-Id'= SessionId, 'Auth-Session-State'=1, + 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=2001, 'Subscription-Data'=SubscrData}; + #{message_type:=location_upd_err, cause:=Cause} -> + {Res, ExpRes} = gsup_cause2dia(Cause), + Resp = #'ULA'{'Session-Id'= SessionId, 'Auth-Session-State'=1, + 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=Res, 'Experimental-Result'=ExpRes}; + _ -> + Resp = #'ULA'{'Session-Id'= SessionId, 'Auth-Session-State'=1, + 'Origin-Host'=OH, 'Origin-Realm'=OR, + 'Result-Code'=fixme} + end + end, + {reply, Resp}; + +handle_request(Packet, _SvcName, {_,_}) -> + lager:error("Unsuppoerted message: ~p~n", [Packet]), discard.