1%%<copyright>
2%% <year>2005-2008</year>
3%% <holder>Ericsson AB, All Rights Reserved</holder>
4%%</copyright>
5%%<legalnotice>
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% The Initial Developer of the Original Code is Ericsson AB.
19%%</legalnotice>
20%%
21%%----------------------------------------------------------------------
22%% Purpose: Erlang record definitions for each named and unnamed
23%%          SEQUENCE and SET in module MEDIA-GATEWAY-CONTROL
24%%----------------------------------------------------------------------
25
26-record('MegacoMessage',
27	{
28	  authHeader = asn1_NOVALUE,
29	  mess
30	 }).
31
32-record('AuthenticationHeader',
33	{
34	  secParmIndex,
35	  seqNum,
36	  ad
37	 }).
38
39-record('Message',
40	{
41	  version,
42	  mId,
43	  messageBody
44	 }). % with extension mark
45
46-record('DomainName',
47	{
48	  name,
49	  portNumber = asn1_NOVALUE
50	 }).
51
52-record('IP4Address',
53	{
54	  address,
55	  portNumber = asn1_NOVALUE
56	 }).
57
58-record('IP6Address',
59	{
60	  address,
61	  portNumber = asn1_NOVALUE
62	 }).
63
64
65%% Transaction ::= CHOICE
66%% {
67%% 	transactionRequest		TransactionRequest,
68%% 	transactionPending		TransactionPending,
69%% 	transactionReply		TransactionReply,
70%% 	transactionResponseAck		TransactionResponseAck,
71%% 	-- use of response acks is dependent on underlying transport
72%% 	...,
73%% 	segmentReply			SegmentReply
74%% }
75
76-record('TransactionRequest',
77	{
78	  transactionId,
79	  actions = []
80	 }). % with extension mark
81
82-record('TransactionPending',
83	{
84	  transactionId
85	 }). % with extension mark
86
87-record('TransactionReply',
88	{
89	  transactionId,
90	  immAckRequired = asn1_NOVALUE,
91	  transactionResult,
92
93	  %% with extension mark -- v3 --
94
95	  segmentNumber        = asn1_NOVALUE,
96	  segmentationComplete = asn1_NOVALUE
97	 }).
98
99
100%% -- v3 --
101-record('SegmentReply',
102	{
103	  transactionId,
104	  segmentNumber,
105	  segmentationComplete = asn1_NOVALUE
106	 }). % with extension mark
107
108%% SegmentNumber ::= INTEGER(0..65535)
109
110-record('TransactionAck',
111	{
112	  firstAck,
113	  lastAck = asn1_NOVALUE
114	 }).
115
116-record('ErrorDescriptor',
117	{
118	  errorCode,
119	  errorText = asn1_NOVALUE
120	 }).
121
122-record('ActionRequest',
123	{
124	  contextId,
125	  contextRequest = asn1_NOVALUE,
126	  contextAttrAuditReq = asn1_NOVALUE,
127	  commandRequests = []
128	 }).
129
130-record('ActionReply',
131	{
132	  contextId,
133	  errorDescriptor = asn1_NOVALUE,
134	  contextReply = asn1_NOVALUE,
135	  commandReply = []
136	 }).
137
138-record('ContextRequest',
139	{
140	  priority = asn1_NOVALUE,
141	  emergency = asn1_NOVALUE,
142	  topologyReq = asn1_NOVALUE,
143
144	  %% with extension mark -- prev3b --
145
146	  iepscallind = asn1_NOVALUE,
147	  contextProp = asn1_NOVALUE,
148
149	  %% -- prev3c --
150
151	  contextList = asn1_NOVALUE
152
153	 }).
154
155-record('ContextAttrAuditRequest',
156	{
157	  topology = asn1_NOVALUE,
158	  emergency = asn1_NOVALUE,
159	  priority = asn1_NOVALUE,
160
161	  %% with extension mark -- prev3b --
162
163	  iepscallind = asn1_NOVALUE,
164	  contextPropAud = asn1_NOVALUE,
165
166	  %% -- prev3c --
167
168	  selectpriority = asn1_NOVALUE,
169	  selectemergency = asn1_NOVALUE,
170	  selectiepscallind = asn1_NOVALUE,
171	  selectLogic = asn1_NOVALUE
172	 }).
173
174
175%% SelectLogic            ::= CHOICE
176%% {
177%%     andAUDITSelect  NULL,     -- all selection conditions satisfied
178%%     orAUDITSelect   NULL,     -- at least one selection condition satisfied
179%%     ...
180%% }
181
182-record('CommandRequest',
183	{
184	  command,
185	  optional = asn1_NOVALUE,
186	  wildcardReturn = asn1_NOVALUE
187	 }). % with extension mark
188
189-record('TopologyRequest',
190	{
191	  terminationFrom,
192	  terminationTo,
193	  topologyDirection,
194
195	  %% After extension mark
196	  streamID = asn1_NOVALUE,
197
198	  %% -- prev3c --
199	  %% This is actually not according to the standard,
200	  %% but without it 'TopologyRequest' will be useless.
201	  topologyDirectionExtension = asn1_NOVALUE
202
203	 }).
204
205-record('AmmRequest',
206	{
207	  terminationID = [],
208	  descriptors = []
209	 }). % with extension mark
210
211-record('AmmsReply',
212	{
213	  terminationID = [],
214	  terminationAudit = asn1_NOVALUE
215	 }). % with extension mark
216
217-record('SubtractRequest',
218	{
219	  terminationID = [],
220	  auditDescriptor = asn1_NOVALUE
221	 }). % with extension mark
222
223-record('AuditRequest',
224	{
225	  terminationID,
226	  auditDescriptor,
227
228	  %% -- prev3c (after extension mark) --
229
230	  terminationIDList = asn1_NOVALUE
231
232	 }).
233
234%% AuditReply := CHOICE
235%% {
236%%    contextAuditResult   TerminationIDList,
237%%    error                ErrorDescriptor,
238%%    auditResult          AuditResult,
239%%    ...
240%%    auditResultTermList  TermListAuditResult
241%% }
242
243-record('AuditResult',
244	{
245	  terminationID,
246	  terminationAuditResult = []
247	 }).
248
249-record('TermListAuditResult',
250	{
251	  terminationIDList,
252	  terminationAuditResult = []
253	 }). % with extension mark
254
255-record('AuditDescriptor',
256	{
257	  auditToken         = asn1_NOVALUE,
258	  %% with extensions
259	  auditPropertyToken = asn1_NOVALUE
260	 }).
261
262
263%% --- v2 start ---
264
265-record('IndAudMediaDescriptor',
266	{
267	  termStateDescr = asn1_NOVALUE,
268	  streams        = asn1_NOVALUE
269	}). % with extension mark
270
271-record('IndAudStreamDescriptor',
272	{
273	  streamID,
274	  streamParms
275	}). % with extension mark
276
277-record('IndAudStreamParms',
278	{
279	  localControlDescriptor = asn1_NOVALUE,
280	  localDescriptor        = asn1_NOVALUE, %% NOTE: NOT IN TEXT
281	  remoteDescriptor       = asn1_NOVALUE, %% NOTE: NOT IN TEXT
282
283	  %% with extension mark -- prev3b --
284
285	  statisticsDescriptor   = asn1_NOVALUE
286	}).
287
288-record('IndAudLocalControlDescriptor',
289	{
290	  streamMode    = asn1_NOVALUE,
291	  reserveValue  = asn1_NOVALUE,
292	  reserveGroup  = asn1_NOVALUE,
293	  propertyParms = asn1_NOVALUE,
294
295	  %% -- prev3c (after extension mark) --
296
297	  streamModeSel = asn1_NOVALUE
298
299	}).
300
301-record('IndAudPropertyParm',
302	{
303	  name,
304
305	  %% -- prev3c (after extension mark) --
306
307	  propertyParms = asn1_NOVALUE
308	}).
309
310-record('IndAudLocalRemoteDescriptor',
311	{
312	  propGroupID = asn1_NOVALUE,
313	  propGrps
314	}). % with extension mark
315
316%% IndAudPropertyGroup ::= SEQUENCE OF IndAudPropertyParm
317
318
319%% BUGBUG
320%% In text, it can only be one of them in each record.
321%% So, in case it's eventBufferControl or serviceState
322%% propertyParms will be an empty list.
323-record('IndAudTerminationStateDescriptor',
324	{
325	  propertyParms = [],  %% Optional in text...
326	  eventBufferControl = asn1_NOVALUE,
327	  serviceState       = asn1_NOVALUE,
328
329	  %% -- prev3c (after extension mark) --
330
331	  serviceStateSel    = asn1_NOVALUE
332
333	}).
334
335-record('IndAudEventsDescriptor',
336	{
337	  requestID = asn1_NOVALUE,  %% Only optional in ASN.1
338	  pkgdName,
339	  streamID  = asn1_NOVALUE
340	}). % with extension mark
341
342-record('IndAudEventBufferDescriptor',
343	{
344	  eventName,
345	  %% This is an ugly hack to allow the eventParameterName
346	  %% which only exist in text!!
347	  %% streamID = asn1_NOVALUE | integer() |
348	  %%            {eventParameterName, Name}  <- BUGBUG: ONLY IN TEXT
349	  %% Note that the binary codecs will fail to encode
350	  %% if the streamID is not aither asn1_NOVALUE or an integer()
351	  %% So it is recommended to refrain from using this text feature...
352	  streamID = asn1_NOVALUE
353
354	  %% eventParameterName = asn1_NOVALUE %% BUGBUG: ONLY IN TEXT
355
356	}). % with extension mark
357
358-record('IndAudSeqSigList',
359	{
360	  id,
361	  signalList  = asn1_NOVALUE  %% Only in ASN1
362	}). % with extension mark
363
364-record('IndAudSignal',
365	{
366	  signalName,
367	  streamID = asn1_NOVALUE, % Optional in ASN1 & non-existent in text
368
369	  %% -- prev3c (after extension mark) --
370
371	  signalRequestID = asn1_NOVALUE
372
373	}). % with extension mark
374
375-record('IndAudDigitMapDescriptor',
376	{
377	  digitMapName = asn1_NOVALUE  %% OPTIONAL in ASN.1 but not in text
378	}).
379
380-record('IndAudStatisticsDescriptor',
381	{
382	  statName
383	}).
384
385-record('IndAudPackagesDescriptor',
386	{
387	  packageName,
388	  packageVersion
389	}). % with extension mark
390
391
392%% --- v2 end   ---
393
394
395-record('NotifyRequest',
396	{
397	  terminationID = [],
398	  observedEventsDescriptor,
399	  errorDescriptor = asn1_NOVALUE
400	 }). % with extension mark
401
402-record('NotifyReply',
403	{
404	  terminationID   = [],
405	  errorDescriptor = asn1_NOVALUE
406	 }). % with extension mark
407
408-record('ObservedEventsDescriptor',
409	{
410	  requestId,
411	  observedEventLst = []
412	 }).
413
414-record('ObservedEvent',
415	{
416	  eventName,
417	  streamID = asn1_NOVALUE,
418	  eventParList = [],
419	  timeNotation = asn1_NOVALUE
420	 }). % with extension mark
421
422%% This value field of this record is already encoded and will
423%% be inserted as is.
424%% This record could be used either when there is a bug in the
425%% encoder or if an "external" package, unknown to the megaco app,
426%% where the value part requires a special encode.
427-record(megaco_event_parameter,
428	{
429	  name,
430	  value
431	 }).
432
433-record('EventParameter',
434	{
435	  eventParameterName,
436	  value,
437	  extraInfo = asn1_NOVALUE
438	 }). % with extension mark
439
440-record('ServiceChangeRequest',
441	{
442	  terminationID = [],
443	  serviceChangeParms
444	 }). % with extension mark
445
446-record('ServiceChangeReply',
447	{
448	  terminationID = [],
449	  serviceChangeResult = []
450	 }). % with extension mark
451
452-record('TerminationID',
453	{
454	  wildcard,
455	  id
456	 }). % with extension mark
457
458%% TerminationIDList ::= SEQUENCE OF TerminationID
459
460-record('MediaDescriptor',
461	{
462	  termStateDescr = asn1_NOVALUE,
463	  streams        = asn1_NOVALUE
464	 }). % with extension mark
465
466-record('StreamDescriptor',
467	{
468	  streamID,
469	  streamParms
470	 }).
471
472-record('StreamParms',
473	{
474	  localControlDescriptor = asn1_NOVALUE,
475	  localDescriptor = asn1_NOVALUE,
476	  remoteDescriptor = asn1_NOVALUE,
477
478	  %% with extension mark -- prev3b --
479
480	  statisticsDescriptor   = asn1_NOVALUE
481	 }).
482
483-record('LocalControlDescriptor',
484	{
485	  streamMode   = asn1_NOVALUE,
486	  reserveValue = asn1_NOVALUE,
487	  reserveGroup = asn1_NOVALUE,
488	  propertyParms = []
489	 }). % with extension mark
490
491%% StreamMode ::= ENUMERATED
492%% {
493%%   sendOnly(0),
494%%   recvOnly(1),
495%%   sendRecv(2),
496%%   inactive(3),
497%%   loopBack(4),
498%%   ...
499%% }
500
501-record('PropertyParm',
502	{
503	  name,
504	  value,
505	  extraInfo = asn1_NOVALUE
506	 }). % with extension mark
507
508-record('LocalRemoteDescriptor',
509	{
510	  propGrps = []
511	 }). % with extension mark
512
513-record('TerminationStateDescriptor',
514	{
515	  propertyParms = [],
516	  eventBufferControl = asn1_NOVALUE,
517	  serviceState = asn1_NOVALUE
518	 }). % with extension mark
519
520%% EventBufferControl ::= ENUMERATED
521%% {
522%%   off(0),
523%%   lockStep(1),
524%%   ...
525%% }
526
527%% ServiceState ::= ENUMERATED
528%% {
529%%   test(0),
530%%   outOfSvc(1),
531%%   inSvc(2),
532%%   ...
533%% }
534
535-record('MuxDescriptor',
536	{
537	  muxType,
538	  termList = [],
539	  nonStandardData = asn1_NOVALUE
540	 }). % with extension mark
541
542-record('EventsDescriptor',
543	{
544	  requestID,
545	  %% BUGBUG: IG 6.82 was withdrawn
546	  %% requestID = asn1_NOVALUE,
547	  eventList = []
548	 }). % with extension mark
549
550-record('RequestedEvent',
551	{
552	  pkgdName,
553	  streamID = asn1_NOVALUE,
554	  eventAction = asn1_NOVALUE,
555	  evParList = []
556	 }). % with extension mark
557
558%% -- prev3c --
559-record('RegulatedEmbeddedDescriptor',
560	{
561	  secondEvent       = asn1_NOVALUE,
562	  signalsDescriptor = asn1_NOVALUE
563	 }). % with extension mark
564
565%% NotifyBehaviour ::= CHOICE
566%% {
567%%    notifyImmediate  NULL,
568%%    notifyRegulated  RegulatedEmbeddedDescriptor,
569%%    neverNotify      NULL,
570%%    ...
571%% }
572
573-record('RequestedActions',
574	{
575	  keepActive = asn1_NOVALUE,
576	  eventDM = asn1_NOVALUE,
577	  secondEvent = asn1_NOVALUE,
578	  signalsDescriptor = asn1_NOVALUE,
579
580	  %% -- prev3c (after extension mark) --
581
582	  notifyBehaviour       = asn1_NOVALUE,
583	  resetEventsDescriptor = asn1_NOVALUE
584
585	 }).
586
587-record('SecondEventsDescriptor',
588	{
589	  requestID,
590	  %% BUGBUG: IG 6.82 was withdrawn
591	  %% requestID = asn1_NOVALUE,
592	  eventList = []
593	 }). % with extension mark
594
595-record('SecondRequestedEvent',
596	{
597	  pkgdName,
598	  streamID = asn1_NOVALUE,
599	  eventAction = asn1_NOVALUE,
600	  evParList = []
601	 }). % with extension mark
602
603-record('SecondRequestedActions',
604	{
605	  keepActive = asn1_NOVALUE,
606	  eventDM = asn1_NOVALUE,
607	  signalsDescriptor = asn1_NOVALUE,
608
609	  %% -- prev3c (after extension mark) --
610
611	  notifyBehaviour       = asn1_NOVALUE,
612	  resetEventsDescriptor = asn1_NOVALUE
613
614	 }).
615
616
617%% EventBufferDescriptor ::= SEQUENCE OF EventSpec
618
619-record('EventSpec',
620	{
621	  eventName,
622	  streamID = asn1_NOVALUE,
623	  eventParList = []
624	 }). % with extension mark
625
626
627%% SignalsDescriptor ::= SEQUENCE OF SignalRequest
628
629%% SignalRequest ::= CHOICE
630%%  {
631%%    signal         Signal,
632%%    seqSigList     SeqSigList,
633%%    ...
634%%  }
635
636
637-record('SeqSigList',
638	{
639	  id,
640	  signalList = []
641	 }).
642
643-record('Signal',
644	{
645	  signalName,
646	  streamID = asn1_NOVALUE,
647	  sigType = asn1_NOVALUE,
648	  duration = asn1_NOVALUE,
649	  notifyCompletion = asn1_NOVALUE,
650	  keepActive = asn1_NOVALUE,
651	  sigParList = [],
652
653	  %% with extension mark -- prev3b --
654
655	  direction = asn1_NOVALUE,
656	  requestID = asn1_NOVALUE,
657
658	  %% -- prev3c --
659
660	  intersigDelay = asn1_NOVALUE
661
662	 }).
663
664%% SignalType ::= ENUMERATED
665%%  {
666%%    brief(0),
667%%    onOff(1),
668%%    timeOut(2),
669%%    ...
670%%  }
671
672%% SignalDirection ::= ENUMERATED
673%%  {
674%%    internal(0),
675%%    external(1),
676%%    both(3),
677%%    ...
678%%  }
679
680%% SignalName ::= PkgdName
681
682%% NotifyCompletion ::= BIT STRING
683%%  {
684%%    onTimeOut(0), onInterruptByEvent(1),
685%%    onInterruptByNewSignalDescr(2), otherReason(3), onIteration(4)
686%%  }
687
688-record('SigParameter',
689	{
690	  sigParameterName,
691	  value,
692	  extraInfo = asn1_NOVALUE
693	 }). % with extension mark
694
695-record('ModemDescriptor',
696	{
697	  mtl,
698	  mpl,
699	  nonStandardData = asn1_NOVALUE
700	 }).
701
702-record('DigitMapDescriptor',
703	{
704	  digitMapName = asn1_NOVALUE,
705	  digitMapValue = asn1_NOVALUE
706	 }).
707
708-record('DigitMapValue',
709	{
710	  startTimer = asn1_NOVALUE,
711	  shortTimer = asn1_NOVALUE,
712	  longTimer = asn1_NOVALUE,
713	  digitMapBody,
714	  %% with extensions
715	  durationTimer = asn1_NOVALUE
716	 }).
717
718-record('ServiceChangeParm',
719	{
720	  serviceChangeMethod,
721	  serviceChangeAddress = asn1_NOVALUE,
722	  serviceChangeVersion = asn1_NOVALUE,
723	  serviceChangeProfile = asn1_NOVALUE,
724	  serviceChangeReason,
725	  serviceChangeDelay = asn1_NOVALUE,
726	  serviceChangeMgcId = asn1_NOVALUE,
727	  timeStamp = asn1_NOVALUE,
728	  nonStandardData = asn1_NOVALUE,
729
730	  %% with extension mark -- prev3b (serviceChangeIncompleteFlag) --
731
732	  serviceChangeInfo = asn1_NOVALUE,
733	  serviceChangeIncompleteFlag = asn1_NOVALUE
734	 }).
735
736-record('ServiceChangeResParm',
737	{
738	  serviceChangeMgcId = asn1_NOVALUE,
739	  serviceChangeAddress = asn1_NOVALUE,
740	  serviceChangeVersion = asn1_NOVALUE,
741	  serviceChangeProfile = asn1_NOVALUE,
742	  timeStamp = asn1_NOVALUE
743	 }). % with extension mark
744
745
746%% This is the actual ASN.1 type and it is as this it will
747%% be represented if the encoding config [native] is chosen.
748%% %% String of at least 1 character and at most 67 characters (ASN.1).
749%% %% 64 characters for name, 1 for "/", 2 for version to match ABNF
750%% -record('ServiceChangeProfile',
751%% 	{
752%% 	  profileName
753%% 	 }
754%%        ).
755
756-record('ServiceChangeProfile',
757	{
758	  profileName,
759	  version
760	 }).
761
762
763-record('PackagesItem',
764	{
765	  packageName,
766	  packageVersion
767	 }). % with extension mark
768
769-record('StatisticsParameter',
770	{
771	  statName,
772	  statValue = asn1_NOVALUE
773	 }).
774
775-record('TimeNotation',
776	{
777	  date,
778	  time
779	 }).
780
781