~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to lib/megaco/src/binary/megaco_binary_name_resolver_v2.erl

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
22
22
-module(megaco_binary_name_resolver_v2).
23
23
 
24
24
-include_lib("megaco/src/engine/megaco_message_internal.hrl").
 
25
-include_lib("megaco/src/engine/megaco_internal.hrl").
25
26
 
26
27
-define(LOWER(Char),
27
28
        if
46
47
            exit({bad_term_id, TermId})
47
48
    end;        
48
49
encode_name(_Config, Scope, Item) ->
49
 
%     i("encode_name(~p) -> entry with Item: ~p",[Scope, Item]),
 
50
    ?d("encode_name(~p) -> entry with"
 
51
       "~n   Item: ~p", [Scope, Item]),
50
52
    encode(Scope, Item).
51
53
 
52
54
decode_name(Config, term_id, TermId) ->
57
59
            exit({bad_term_id, TermId})
58
60
    end;
59
61
decode_name(_Config, Scope, Item) ->
60
 
%     i("decode_name(~p) -> entry with Item: ~p",[Scope, Item]),
 
62
    ?d("decode_name(~p) -> entry with"
 
63
       "~n   Item: ~p", [Scope, Item]),
61
64
    decode(Scope, Item).
62
65
 
63
66
%%----------------------------------------------------------------------
64
 
%% 12.1.1 Package
65
 
%% 
66
 
%% Overall description of the package, specifying:
67
 
%% 
68
 
%%         Package Name: only descriptive,
69
 
%%         PackageID:  Is an identifier
70
 
%%         Description:
71
 
%%         Version:
72
 
%%                 A new version of a package can only add additional
73
 
%%                 Properties, Events, Signals, Statistics and new possible
74
 
%%                 values for an existing parameter described in the
75
 
%%                 package. No deletions or modifications shall be allowed.
76
 
%%                 A version is an integer in the range from 1 to 99.
77
 
%% 
78
 
%%         Designed to be extended only (Optional):
79
 
%% 
80
 
%%                This indicates that the package has been expressly 
81
 
%%                designed to be extended by others, not to be directly 
82
 
%%                referenced.  For example, the package may not have any 
83
 
%%                function on its own or be nonsensical on its own.  
84
 
%%                The MG SHOULD NOT publish this PackageID when reporting 
85
 
%%                packages.
86
 
%%
87
 
%%         Extends (Optional):
88
 
%%                 A package may extend an existing package. The version of
89
 
%%                 the original package must be specified. When a package
90
 
%%                 extends another package it shall only add additional
91
 
%%                 Properties, Events, Signals, Statistics and new possible
92
 
%%                 values for an existing parameter described in the original
93
 
%%                 package. An extended package shall not redefine or
94
 
%%                 overload a name defined in the original package.
95
 
%%                 Hence, if package B version 1 extends package A version 1,
96
 
%%                 version 2 of B will not be able to extend the A version 2
97
 
%%                 if A version 2 defines a name already in B version 1.
98
 
%% 
99
 
%% 12.1.2.  Properties
100
 
%% 
101
 
%% Properties defined by the package, specifying:
102
 
%% 
103
 
%%         Property Name: only descriptive.
104
 
%%         PropertyID:  Is an identifier
105
 
%%         Description:
106
 
%%         Type: One of:
107
 
%%                 String: UTF-8 string
108
 
%%                 Integer: 4 byte signed integer
109
 
%%                 Double: 8 byte signed integer
110
 
%%                 Character: Unicode UTF-8 encoding of a single letter.
111
 
%%                         Could be more than one octet.
112
 
%%                 Enumeration: One of a list of possible unique values (See 12.3)
113
 
%%                 Sub-list: A list of several values from a list
114
 
%%                 Boolean
115
 
%%         Possible Values:
116
 
%%         Defined in:
117
 
%%                 Which descriptor the property is defined in.  LocalControl
118
 
%%                 is for stream dependent properties. TerminationState is for
119
 
%%                 stream independent properties.
120
 
%%         Characteristics: Read / Write or both, and (optionally), global:
121
 
%%                 Indicates whether a property is read-only, or read-write,
122
 
%%                 and if it is global.  If Global is omitted, the property
123
 
%%                 is not global.  If a property is declared as global,
124
 
%%                 the value of the property is shared by all terminations
125
 
%%                 realizing the package.
126
 
%% 
127
 
%% 12.1.3.  Events
128
 
%% 
129
 
%% Events defined by the package, specifying:
130
 
%% 
131
 
%%         Event name: only descriptive.
132
 
%%         EventID:  Is an identifier
133
 
%%         Description:
134
 
%%         EventsDescriptor Parameters:
135
 
%%                 Parameters used by the MGC to configure the event,
136
 
%%                 and found in the EventsDescriptor.  See section 12.2.
137
 
%%         ObservedEventsDescriptor Parameters:
138
 
%%                 Parameters returned to the MGC in  Notify requests and in
139
 
%%                 replies to command requests from the MGC that audit
140
 
%%                 ObservedEventsDescriptor, and found in the
141
 
%%                 ObservedEventsDescriptor.  See section 12.2.
142
 
%% 
143
 
%% 12.1.4.  Signals
144
 
%% 
145
 
%% Signals defined by the package, specifying:
146
 
%% 
147
 
%%         Signal Name: only descriptive.
148
 
%%         SignalID:  Is an identifier. SignalID is used in a
149
 
%%                         SignalsDescriptor
150
 
%%         Description
151
 
%%         SignalType: One of:
152
 
%%                         OO (On/Off)
153
 
%%                         TO (TimeOut)
154
 
%%                         BR (Brief)
155
 
%% 
156
 
%% 
157
 
%% Note:SignalType may be defined such that it is dependent on the
158
 
%%           value of one or more parameters. Signals that would be played
159
 
%%      with SignalType BR should have a default duration. The package has
160
 
%%      to define the default duration and signalType.
161
 
%% 
162
 
%%           Duration: in hundredths of seconds
163
 
%%           Additional Parameters: See section 12.2
164
 
%% 
165
 
%% 
166
 
%% 12.1.5.  Statistics
167
 
%% 
168
 
%% Statistics defined by the package, specifying:
169
 
%% 
170
 
%%         Statistic name: only descriptive.
171
 
%%         StatisticID:  Is an identifier
172
 
%%         StatisticID is used in a StatisticsDescriptor
173
 
%%         Description
174
 
%%         Units: unit of measure, e.g. milliseconds, packets
175
 
%% 
176
 
%% 
177
 
%% 12.1.6.  Procedures
178
 
%% 
179
 
%% Additional guidance on the use of the package.
180
 
%% 
181
 
%% 12.2.  Guidelines to defining  Properties, Statistics and Parameters to
182
 
%% Events and Signals.
183
 
%% 
184
 
%%         Parameter Name: only descriptive
185
 
%%         ParameterID: Is an identifier
186
 
%%         Type: One of:
187
 
%%                 String: UTF-8 octet string
188
 
%%                 Integer: 4 octet signed integer
189
 
%%                 Double: 8 octet signed integer
190
 
%%                 Character: Unicode UTF-8 encoding of a single letter.
191
 
%%                         Could be more than one octet.
192
 
%%                 Enumeration: One of a list of possible unique values
193
 
%%                         (See 12.3)
194
 
%%                 Sub-list: A list of several values from a list
195
 
%%                 Boolean
196
 
%%         Possible values:
197
 
%%         Description:
198
 
%% 
199
 
%% 
200
 
%% 12.3.  Lists
201
 
%% 
202
 
%% Possible values for parameters include enumerations.  Enumerations may
203
 
%% be defined in a list.  It is recommended that the list be IANA
204
 
%% registered so that packages that extend the list can be defined without
205
 
%% concern for conflicting names.
206
 
%% 
207
 
%% 12.4.  Identifiers
208
 
%% 
209
 
%% Identifiers in text encoding shall be strings of up to 64 characters,
210
 
%% containing no spaces, starting with an alphanumeric character and con-
211
 
%% sisting of alphanumeric characters and / or digits, and possibly includ-
212
 
%% ing the special character underscore ("_").  Identifiers in binary
213
 
%% encoding are 2 octets long.  Both text and binary values shall be speci-
214
 
%% fied for each identifier, including identifiers used as values in
215
 
%% enumerated types.
 
67
%% 12.1.1   Package
 
68
%% 
 
69
%%    Overall description of the package, specifying:
 
70
%% 
 
71
%%       Package Name: only descriptive
 
72
%% 
 
73
%%       PackageID: is an identifier
 
74
%% 
 
75
%%       Description:
 
76
%% 
 
77
%%       Version:
 
78
%% 
 
79
%%    A new version of a package can only add additional Properties,
 
80
%%    Events, Signals, Statistics and new possible values for an existing
 
81
%%    parameter described in the original package. No deletions or
 
82
%%    modifications shall be allowed. A version is an integer in the range
 
83
%%    from 1 to 99.
 
84
%% 
 
85
%%       Designed to be extended only (Optional): Yes
 
86
%% 
 
87
%%    This indicates that the package has been expressly designed to be
 
88
%%    extended by others, not to be directly referenced. For example, the
 
89
%%    package may not have any function on its own or be nonsensical on its
 
90
%%    own. The MG SHOULD NOT publish this PackageID when reporting
 
91
%%    packages.
 
92
%% 
 
93
%%       Extends (Optional): existing package Descriptor
 
94
%% 
 
95
%%    A package may extend an existing package. The version of the original
 
96
%%    package must be specified. When a package extends another package it
 
97
%%    shall only add additional Properties, Events, Signals, Statistics and
 
98
%%    new possible values for an existing parameter described in the
 
99
%%    original package. An extended package shall not redefine or overload
 
100
%%    an identifier defined in the original package and packages it may
 
101
%%    have extended (multiple levels of extension). Hence, if package B
 
102
%%    version 1 extends package A version 1, version 2 of B will not be
 
103
%%    able to extend the A version 2 if A version 2 defines a name already
 
104
%%    in B version 1.
 
105
%% 
 
106
%% 
 
107
%% 12.1.2   Properties
 
108
%% 
 
109
%%    Properties defined by the package, specifying:
 
110
%% 
 
111
%%       Property Name: only descriptive
 
112
%% 
 
113
%%       PropertyID: is an identifier
 
114
%% 
 
115
%%       Description:
 
116
%% 
 
117
%%       Type: One of:
 
118
%% 
 
119
%%          Boolean
 
120
%% 
 
121
%%          String: UTF-8 string
 
122
%% 
 
123
%%          Octet String: A number of octets.  See Annex A and Annex B.3
 
124
%%          for encoding
 
125
%% 
 
126
%%          Integer: 4 byte signed integer
 
127
%% 
 
128
%%          Double: 8 byte signed integer
 
129
%% 
 
130
%%          Character: unicode UTF-8 encoding of a single letter. Could be
 
131
%%          more than one octet.
 
132
%% 
 
133
%%          Enumeration: one of a list of possible unique values (see 12.3)
 
134
%% 
 
135
%%          Sub-list: a list of several values from a list. The type of
 
136
%%          sub-list SHALL also be specified.  The type shall be chosen
 
137
%%          from the types specified in this section (with the exception of
 
138
%%          sub-list). For example, Type: sub-list of enumeration.  The
 
139
%%          encoding of sub-lists is specified in Annexes A and B.3.
 
140
%% 
 
141
%%       Possible values:
 
142
%% 
 
143
%%    A package MUST specify either a specific set of values or a
 
144
%%    description of how values are determined.  A package MUST also
 
145
%%    specify a default value or the default behaviour when the value is
 
146
%%    omitted from its descriptor.  For example, a package may specify that
 
147
%%    procedures related to the property are suspended when it value is
 
148
%%    omitted.  A default value (but not procedures) may be specified as
 
149
%%    provisionable.
 
150
%% 
 
151
%%       Defined in:
 
152
%% 
 
153
%%    Which H.248.1 descriptor the property is defined in. LocalControl is
 
154
%%    for stream dependent properties. TerminationState is for stream
 
155
%%    independent properties. These are expected to be the most common
 
156
%%    cases, but it is possible for properties to be defined in other
 
157
%%    descriptors.
 
158
%% 
 
159
%%       Characteristics: Read/Write or both, and (optionally), global:
 
160
%% 
 
161
%%    Indicates whether a property is read-only, or read-write, and if it
 
162
%%    is global. If Global is omitted, the property is not global. If a
 
163
%%    property is declared as global, the value of the property is shared
 
164
%%    by all Terminations realizing the package.
 
165
%% 
 
166
%% 
 
167
%% 12.1.3   Events
 
168
%% 
 
169
%%    Events defined by the package, specifying:
 
170
%% 
 
171
%%       Event name: only descriptive
 
172
%% 
 
173
%%       EventID: is an identifier
 
174
%% 
 
175
%%       Description:
 
176
%% 
 
177
%%       EventsDescriptor Parameters:
 
178
%% 
 
179
%%    Parameters used by the MGC to configure the event, and found in the
 
180
%%    EventsDescriptor. See 12.2.
 
181
%% 
 
182
%%       ObservedEventsDescriptor Parameters:
 
183
%% 
 
184
%%    Parameters returned to the MGC in Notify requests and in replies to
 
185
%%    command requests from the MGC that audit ObservedEventsDescriptor,
 
186
%%    and found in the ObservedEventsDescriptor. See 12.2.
 
187
%% 
 
188
%% 
 
189
%% 12.1.4   Signals
 
190
%% 
 
191
%%    Signals defined by the package, specifying:
 
192
%% 
 
193
%%       Signal Name: only descriptive
 
194
%% 
 
195
%%       SignalID: is an identifier. SignalID is used in a
 
196
%%       SignalsDescriptor
 
197
%% 
 
198
%%       Description
 
199
%% 
 
200
%%       SignalType: one of:
 
201
%% 
 
202
%%             OO (On/Off)
 
203
%% 
 
204
%%             TO (TimeOut)
 
205
%% 
 
206
%%             BR (Brief)
 
207
%% 
 
208
%%    NOTE - SignalType may be defined such that it is dependent on the
 
209
%%    value of one or more parameters. The package MUST specify a default
 
210
%%    signal type.  If the default type is TO, the package MUST specify a
 
211
%%    default duration which may be provisioned.  A default duration is
 
212
%%    meaningless for BR.
 
213
%% 
 
214
%%       Duration: in hundredths of seconds
 
215
%% 
 
216
%%       Additional Parameters: see 12.2
 
217
%% 
 
218
%% 
 
219
%% 12.1.5   Statistics
 
220
%% 
 
221
%%    Statistics defined by the package, specifying:
 
222
%% 
 
223
%%       Statistic name: only descriptive
 
224
%% 
 
225
%%       StatisticID: is an identifier
 
226
%% 
 
227
%%    StatisticID is used in a StatisticsDescriptor
 
228
%% 
 
229
%%       Description:
 
230
%% 
 
231
%%       Type: One of:
 
232
%%           Boolean
 
233
%%           String: UTF-8 string
 
234
%%           Octet String: A number of octets. See Annex A and B.3 for encoding
 
235
%%           Integer: 4 byte signed integer
 
236
%%           Double: 8 byte signed integer
 
237
%%           Character: Unicode UTF-8 encoding of a single letter. 
 
238
%%                             Could be more than one octet.
 
239
%%           Enumeration: One of a list of possible unique values (see 12.3)
 
240
%%           Sub-list: A list of several values from a list. 
 
241
%%                     The type of sub-list SHALL also be specified. 
 
242
%%                     The type shall be chosen from the types specified
 
243
%%                     in this clause (with the exception of sub-list). 
 
244
%%                     For example, Type: sub-list of enumeration. 
 
245
%%                     The encoding of sub-lists is specified in 
 
246
%%                     Annex A and B.3.
 
247
%%       Possible Values:
 
248
%%           A package must indicate the unit of measure, e.g., 
 
249
%%           milliseconds, packets, either here or along with the type 
 
250
%%           above, as well as indicating any restriction on the range.
 
251
%% 
 
252
%% 
 
253
%% 12.1.6   Procedures
 
254
%% 
 
255
%%    Additional guidance on the use of the package.
 
256
%% 
 
257
%% 
 
258
%% 12.2  Guidelines to defining Parameters to Events and Signals
 
259
%% 
 
260
%%       Parameter Name: only descriptive
 
261
%% 
 
262
%%       ParameterID: is an identifier. The textual ParameterID of
 
263
%%       parameters to Events and Signals shall not start with "EPA" and
 
264
%%       "SPA", respectively. The textual ParameterID shall also not be
 
265
%%       "ST", "Stream", "SY", "SignalType", "DR", "Duration", "NC",
 
266
%%       "NotifyCompletion", "KA", "Keepactive", "EB", "Embed", "DM" or
 
267
%%       "DigitMap".
 
268
%% 
 
269
%%       Type: One of:
 
270
%% 
 
271
%%          Boolean
 
272
%% 
 
273
%%          String: UTF-8 octet string
 
274
%% 
 
275
%%          Octet String: A number of octets.  See Annex A and Annex B.3
 
276
%%          for encoding
 
277
%% 
 
278
%%          Integer: 4-octet signed integer
 
279
%% 
 
280
%%          Double: 8-octet signed integer
 
281
%% 
 
282
%%          Character: unicode UTF-8 encoding of a single letter. Could be
 
283
%%          more than one octet.
 
284
%% 
 
285
%%          Enumeration: one of a list of possible unique values (see 12.3)
 
286
%% 
 
287
%%          Sub-list: a list of several values from a list (not supported
 
288
%%          for statistics). The type of sub-list SHALL also be specified.
 
289
%%          The type shall be chosen from the types specified in this
 
290
%%          section (with the exception of sub-list). For example, Type:
 
291
%%          sub-list of enumeration.  The encoding of sub-lists is
 
292
%%          specified in Annexes A and B.3.
 
293
%% 
 
294
%%       Possible values:
 
295
%% 
 
296
%%    A package MUST specify either a specific set of values or a
 
297
%%    description of how values are determined.  A package MUST also
 
298
%%    specify a default value or the default behavior when the value is
 
299
%%    omitted from its descriptor.  For example, a package may specify that
 
300
%%    procedures related to the parameter are suspended when it value is
 
301
%%    omitted.  A default value (but not procedures) may be specified as
 
302
%%    provisionable.
 
303
%% 
 
304
%%       Description:
 
305
%% 
 
306
%% 
 
307
%% 12.3  Lists
 
308
%% 
 
309
%%    Possible values for parameters include enumerations. Enumerations may
 
310
%%    be defined in a list. It is recommended that the list be IANA
 
311
%%    registered so that packages that extend the list can be defined
 
312
%%    without concern for conflicting names.
 
313
%% 
 
314
%% 
 
315
%% 12.4  Identifiers
 
316
%% 
 
317
%%    Identifiers in text encoding shall be strings of up to 64 characters,
 
318
%%    containing no spaces, starting with an alphabetic character and
 
319
%%    consisting of alphanumeric characters and/or digits, and possibly
 
320
%%    including the special character underscore ("_").
 
321
%% 
 
322
%%    Identifiers in binary encoding are 2 octets long.
 
323
%% 
 
324
%%    Both text and binary values shall be specified for each identifier,
 
325
%%    including identifiers used as values in enumerated types.
 
326
%% 
 
327
%% 
 
328
%% 12.5  Package registration
 
329
%% 
 
330
%%    A package can be registered with IANA for interoperability reasons.
 
331
%%    See clause 14 for IANA considerations.
 
332
%% 
216
333
%%----------------------------------------------------------------------
217
334
 
218
335
capabilities() ->
281
398
decode(dialplan, Dialplan) ->
282
399
    decode_dialplan(Dialplan);
283
400
decode(Scope, [A, B | Item]) when atom(Scope) ->
284
 
%     i("decode(~p) -> entry with"
285
 
%       "~n   A:    ~p"
286
 
%       "~n   B:    ~p"
287
 
%       "~n   Item: ~p",[Scope,A,B,Item]),
 
401
    ?d("decode(~p) -> entry with"
 
402
       "~n   A:    ~p"
 
403
       "~n   B:    ~p"
 
404
       "~n   Item: ~p", [Scope, A, B, Item]),
288
405
    case decode_package([A, B]) of
289
406
        "" ->
290
 
%           i("decode_package -> \"no\" package",[]),
 
407
            ?d("decode -> \"no\" package",[]),
291
408
            decode_item(Scope, [A, B], Item);
292
409
        Package ->
293
 
%           i("decode -> Package: ~p",[Package]),
 
410
            ?d("decode -> Package: ~p", [Package]),
294
411
            Package ++ "/" ++ decode_item(Scope, [A, B], Item)
295
412
    end;
296
413
decode({Scope, [A, B | Item]}, SubItem) when atom(Scope) ->
297
 
%     i("decode(~p) -> entry with"
298
 
%       "~n   A:       ~p"
299
 
%       "~n   B:       ~p"
300
 
%       "~n   Item:    ~p"
301
 
%       "~n   SubItem: ~p",[Scope, A, B, Item, SubItem]),
 
414
    ?d("decode(~p) -> entry with"
 
415
       "~n   A:       ~p"
 
416
       "~n   B:       ~p"
 
417
       "~n   Item:    ~p"
 
418
       "~n   SubItem: ~p", [Scope, A, B, Item, SubItem]),
302
419
    decode_item({Scope, Item}, [A, B], SubItem).
303
420
 
304
421
decode_item(Scope, [A, B], Item) ->
305
 
%     i("decode_item -> entry",[]),
 
422
    ?d("decode_item -> entry",[]),
306
423
    case A of
307
424
        16#00 -> 
308
425
            case B of
309
 
                16#0e -> decode_g(Scope, Item);
310
 
                16#0f -> decode_root(Scope, Item);
311
 
                16#01 -> decode_tonegen(Scope, Item);
312
 
                16#02 -> decode_tonedet(Scope, Item);
313
 
                16#03 -> decode_dg(Scope, Item);
314
 
                16#04 -> decode_dd(Scope, Item);
315
 
                16#05 -> decode_cg(Scope, Item);
316
 
                16#06 -> decode_cd(Scope, Item);
 
426
                16#01 -> decode_g(Scope, Item);
 
427
                16#02 -> decode_root(Scope, Item);
 
428
                16#03 -> decode_tonegen(Scope, Item);
 
429
                16#04 -> decode_tonedet(Scope, Item);
 
430
                16#05 -> decode_dg(Scope, Item);
 
431
                16#06 -> decode_dd(Scope, Item);
 
432
                16#07 -> decode_cg(Scope, Item);
 
433
                16#08 -> decode_cd(Scope, Item);
317
434
                16#09 -> decode_al(Scope, Item);
318
435
                16#0a -> decode_ct(Scope, Item);
319
436
                16#0b -> decode_nt(Scope, Item);
333
450
    end.
334
451
 
335
452
decode_package(Package) ->
336
 
%     i("decode_package -> entry with Package: ~p",[Package]),
 
453
    ?d("decode_package -> entry with"
 
454
       "~n   Package: ~p", [Package]),
337
455
    [A, B] = Package,
338
456
    case A of
339
457
        16#00 -> 
340
458
            case B of
341
 
                16#0e -> "g";
342
 
                16#0f -> "root";
343
 
                16#01 -> "tonegen";
344
 
                16#02 -> "tonedet";
345
 
                16#03 -> "dg";
346
 
                16#04 -> "dd";
347
 
                16#05 -> "cg";
348
 
                16#06 -> "cd";
 
459
                16#01 -> "g";
 
460
                16#02 -> "root";
 
461
                16#03 -> "tonegen";
 
462
                16#04 -> "tonedet";
 
463
                16#05 -> "dg";
 
464
                16#06 -> "dd";
 
465
                16#07 -> "cg";
 
466
                16#08 -> "cd";
349
467
                16#09 -> "al";
350
468
                16#0a -> "ct";
351
469
                16#0b -> "nt";
406
524
encode(dialplan, Dialplan) ->
407
525
    encode_dialplan(Dialplan);
408
526
encode(Scope, PackageItem) when atom(Scope) ->
409
 
%     i("encode(~p) -> entry with PackageItem: ~p",[Scope, PackageItem]),
 
527
    ?d("encode(~p) -> entry with"
 
528
       "~n   PackageItem: ~p", [Scope, PackageItem]),
410
529
    case string:tokens(PackageItem, [$/]) of
411
530
        [Package, Item] ->
412
 
%             i("encode -> "
413
 
%               "~n   Package: ~p"
414
 
%               "~n   Item:    ~p",[Package, Item]),
 
531
            ?d("encode -> "
 
532
               "~n   Package: ~p"
 
533
               "~n   Item:    ~p", [Package, Item]),
415
534
            encode_package(Package) ++ encode_item(Scope, Package, Item);
416
535
        [Item] ->
417
 
%             i("encode -> Item: ~p",[Item]),
 
536
            ?d("encode -> Item: ~p", [Item]),
418
537
            [16#00, 16#00 | encode_native(Scope, Item)]
419
538
    end;
420
539
encode({Scope, PackageItem}, SubItem) when atom(Scope) ->
421
 
%     i("encode(~p) -> entry with"
422
 
%       "~n   PackageItem: ~p"
423
 
%       "~n   SubItem:     ~p",[Scope, PackageItem, SubItem]),
 
540
    ?d("encode(~p) -> entry with"
 
541
       "~n   PackageItem: ~p"
 
542
       "~n   SubItem:     ~p", [Scope, PackageItem, SubItem]),
424
543
    case string:tokens(PackageItem, [$/]) of
425
544
        [Package, Item] ->
426
 
%             i("encode -> "
427
 
%               "~n   Package: ~p"
428
 
%               "~n   Item:    ~p",[Package, Item]),
 
545
            ?d("encode -> "
 
546
               "~n   Package: ~p"
 
547
               "~n   Item:    ~p", [Package, Item]),
429
548
            encode_item({Scope, Item}, Package, SubItem);
430
549
        [_Item] ->
431
 
%             i("encode -> _Item: ~p",[_Item]),
 
550
            ?d("encode -> _Item: ~p", [_Item]),
432
551
            encode_native(Scope, SubItem)
433
552
    end.
434
553
 
435
554
encode_item(_Scope, _Package, "*") ->
436
555
    [16#ff, 16#ff];
437
556
encode_item(Scope, Package, Item) ->
438
 
%     i("encode_item(~s) -> entry",[Package]),
 
557
    ?d("encode_item(~s) -> entry", [Package]),
439
558
    case Package of
440
559
        "g"       -> encode_g(Scope, Item);
441
560
        "root"    -> encode_root(Scope, Item);
449
568
        "ct"      -> encode_ct(Scope, Item);
450
569
        "nt"      -> encode_nt(Scope, Item);
451
570
        "rtp"     -> encode_rtp(Scope, Item);
452
 
        "swb"     -> encode_swb(Scope, Item);
453
571
        "tdmc"    -> encode_tdmc(Scope, Item);
454
 
        ""        -> encode_native(Scope, Item)
 
572
        ""        -> encode_native(Scope, Item);
 
573
        "swb"     -> encode_swb(Scope, Item)
455
574
    end.
456
575
 
457
576
encode_package(Package) ->
458
577
    case Package of
459
 
        "g"       -> [16#00, 16#0e];
460
 
        "root"    -> [16#00, 16#0f];
461
 
        "tonegen" -> [16#00, 16#01];
462
 
        "tonedet" -> [16#00, 16#02];
463
 
        "dg"      -> [16#00, 16#03];
464
 
        "dd"      -> [16#00, 16#04];
465
 
        "cg"      -> [16#00, 16#05];
466
 
        "cd"      -> [16#00, 16#06];
 
578
        "g"       -> [16#00, 16#01];
 
579
        "root"    -> [16#00, 16#02];
 
580
        "tonegen" -> [16#00, 16#03];
 
581
        "tonedet" -> [16#00, 16#04];
 
582
        "dg"      -> [16#00, 16#05];
 
583
        "dd"      -> [16#00, 16#06];
 
584
        "cg"      -> [16#00, 16#07];
 
585
        "cd"      -> [16#00, 16#08];
467
586
        "al"      -> [16#00, 16#09];
468
587
        "ct"      -> [16#00, 16#0a];
469
588
        "nt"      -> [16#00, 16#0b];
470
589
        "rtp"     -> [16#00, 16#0c];
471
 
        "swb"     -> [16#00, 16#0c];
472
590
        "tdmc"    -> [16#00, 16#0d];
473
591
        ""        -> [16#00, 16#00];
474
 
        "*"       -> [16#ff, 16#ff]
 
592
        "*"       -> [16#ff, 16#ff];
 
593
        "swb"     -> [16#fe, 16#fe]
475
594
    end.
476
595
 
477
596
encode_profile(Profile) ->
570
689
     {property, "maxTerminationsPerContext"},
571
690
     {property, "normalMGExecutionTime"},
572
691
     {property, "normalMGCExecutionTime"},
573
 
     {property, "MGProvisionalResponseTimerValue"},  %% BUGBUG: leading capital?
574
 
     {property, "MGCProvisionalResponseTimerValue"}, %% BUGBUG: leading capital?
575
 
     {property, "MGCOriginatedPendingLimit"},        %% BUGBUG: leading capital?
576
 
     {property, "MGOriginatedPendingLimit"}          %% BUGBUG: leading capital?
 
692
     {property, "MGProvisionalResponseTimerValue"},
 
693
     {property, "MGCProvisionalResponseTimerValue"},
 
694
     {property, "MGCOriginatedPendingLimit"},
 
695
     {property, "MGOriginatedPendingLimit"}
577
696
    ].
578
697
 
579
698
encode_root(Scope, Item) ->
646
765
        [16#00, 16#01] -> "pt"
647
766
    end;
648
767
 
649
 
decode_tonegen({signal_parameter, Item}, _SubItem) ->
 
768
decode_tonegen({signal_parameter, Item}, SubItem) ->
650
769
    case Item of
651
770
        [16#00, 16#01] -> % Event: pt
652
 
            case Item of
 
771
            case SubItem of
653
772
                [16#00, 16#01] -> "tl";
654
773
                [16#00, 16#02] -> "ind"
655
774
            end
753
872
     {signal, "d7"},
754
873
     {signal, "d8"},
755
874
     {signal, "d9"},
756
 
     {signal, "d*"},
757
 
     {signal, "d#"},
 
875
     {signal, "ds"},
 
876
     {signal, "do"},
758
877
     {signal, "da"},
759
878
     {signal, "db"},
760
879
     {signal, "dc"},
775
894
                "d7" -> [16#00, 16#17];
776
895
                "d8" -> [16#00, 16#18];
777
896
                "d9" -> [16#00, 16#19];
778
 
                "d*" -> [16#00, 16#20];
779
 
                "d#" -> [16#00, 16#21];
 
897
                "ds" -> [16#00, 16#20];
 
898
                "do" -> [16#00, 16#21];
780
899
                "da" -> [16#00, 16#1a];
781
900
                "db" -> [16#00, 16#1b];
782
901
                "dc" -> [16#00, 16#1c];
798
917
                [16#00, 16#17] -> "d7";
799
918
                [16#00, 16#18] -> "d8";
800
919
                [16#00, 16#19] -> "d9";
801
 
                [16#00, 16#20] -> "d*";
802
 
                [16#00, 16#21] -> "d#";
 
920
                [16#00, 16#20] -> "ds";
 
921
                [16#00, 16#21] -> "do";
803
922
                [16#00, 16#1a] -> "da";
804
923
                [16#00, 16#1b] -> "db";
805
924
                [16#00, 16#1c] -> "dc";
849
968
 
850
969
capabilities_dd() ->
851
970
    [
852
 
     {event, "ce"}
 
971
     {event, "ce"},
 
972
     {event, "d0"},
 
973
     {event, "d1"},
 
974
     {event, "d2"},
 
975
     {event, "d3"},
 
976
     {event, "d4"},
 
977
     {event, "d5"},
 
978
     {event, "d6"},
 
979
     {event, "d7"},
 
980
     {event, "d8"},
 
981
     {event, "d9"},
 
982
     {event, "ds"},
 
983
     {event, "do"},
 
984
     {event, "da"},
 
985
     {event, "db"},
 
986
     {event, "dc"},
 
987
     {event, "dd"}
853
988
    ].
854
989
 
855
990
encode_dd(event, Item) ->
856
991
    case Item of
857
 
        "ce" -> [16#00, 16#04]
 
992
        "ce" -> [16#00, 16#04];
 
993
        "d0" -> [16#00, 16#10];
 
994
        "d1" -> [16#00, 16#11];
 
995
        "d2" -> [16#00, 16#12];
 
996
        "d3" -> [16#00, 16#13];
 
997
        "d4" -> [16#00, 16#14];
 
998
        "d5" -> [16#00, 16#15];
 
999
        "d6" -> [16#00, 16#16];
 
1000
        "d7" -> [16#00, 16#17];
 
1001
        "d8" -> [16#00, 16#18];
 
1002
        "d9" -> [16#00, 16#19];
 
1003
        "ds" -> [16#00, 16#20];
 
1004
        "do" -> [16#00, 16#21];
 
1005
        "da" -> [16#00, 16#1a];
 
1006
        "db" -> [16#00, 16#1b];
 
1007
        "dc" -> [16#00, 16#1c];
 
1008
        "dd" -> [16#00, 16#1d]
858
1009
    end;
859
1010
 
860
1011
encode_dd({event_parameter, Item}, SubItem) ->
868
1019
 
869
1020
decode_dd(event, Item) ->
870
1021
    case Item of
871
 
        [16#00, 16#04] -> "ce"
 
1022
        [16#00, 16#04] -> "ce";
 
1023
        [16#00, 16#10] -> "d0";
 
1024
        [16#00, 16#11] -> "d1";
 
1025
        [16#00, 16#12] -> "d2";
 
1026
        [16#00, 16#13] -> "d3";
 
1027
        [16#00, 16#14] -> "d4";
 
1028
        [16#00, 16#15] -> "d5";
 
1029
        [16#00, 16#16] -> "d6";
 
1030
        [16#00, 16#17] -> "d7";
 
1031
        [16#00, 16#18] -> "d8";
 
1032
        [16#00, 16#19] -> "d9";
 
1033
        [16#00, 16#20] -> "ds";
 
1034
        [16#00, 16#21] -> "do";
 
1035
        [16#00, 16#1a] -> "da";
 
1036
        [16#00, 16#1b] -> "db";
 
1037
        [16#00, 16#1c] -> "dc";
 
1038
        [16#00, 16#1d] -> "dd"
872
1039
    end;
873
1040
 
874
1041
decode_dd({event_parameter, Item}, SubItem) ->
1016
1183
    ].
1017
1184
 
1018
1185
encode_al(event, Item) ->
1019
 
%     i("encode_al(event) -> entry with Item: ~p",[Item]),
 
1186
    ?d("encode_al(event) -> entry with"
 
1187
       "~n   Item: ~p", [Item]),
1020
1188
    case Item of
1021
1189
        "on" -> [16#00, 16#04];
1022
1190
        "of" -> [16#00, 16#05];
1024
1192
    end;
1025
1193
 
1026
1194
encode_al({event_parameter, Item}, SubItem) ->
1027
 
%     i("encode_al({event_parameter,~p}) -> entry with SubItem: ~p",
1028
 
%       [Item,SubItem]),
 
1195
    ?d("encode_al({event_parameter,~p}) -> entry with"
 
1196
       "~n   SubItem: ~p", [Item, SubItem]),
1029
1197
    case Item of
1030
1198
        "on" ->
1031
1199
            case SubItem of
1045
1213
    end;
1046
1214
 
1047
1215
encode_al(signal, Item) ->
1048
 
%     i("encode_al(signal) -> entry with Item: ~p",[Item]),
 
1216
    ?d("encode_al(signal) -> entry with"
 
1217
       "~n   Item: ~p", [Item]),
1049
1218
    case Item of
1050
1219
        "ri"    -> [16#00, 16#02]
1051
1220
    end;
1052
1221
 
1053
1222
encode_al({signal_parameter, Item}, SubItem) ->
1054
 
%     i("encode_al({signal_parameter,~p}) -> entry with SubItem: ~p",
1055
 
%       [Item,SubItem]),
 
1223
    ?d("encode_al({signal_parameter,~p}) -> entry with"
 
1224
       "~n   SubItem: ~p", [Item, SubItem]),
1056
1225
    case Item of
1057
1226
        "ri" ->
1058
1227
            case SubItem of
1062
1231
    end.
1063
1232
 
1064
1233
decode_al(event, SubItem) ->
1065
 
%     i("decode_al(event) -> entry with"
1066
 
%       "~n   SubItem: ~p",[SubItem]),
 
1234
    ?d("decode_al(event) -> entry with"
 
1235
       "~n   SubItem: ~p", [SubItem]),
1067
1236
    case SubItem of
1068
1237
        [16#00, 16#04] -> "on";
1069
1238
        [16#00, 16#05] -> "of";
1070
1239
        [16#00, 16#06] -> "fl"
1071
1240
    end;
1072
1241
 
1073
 
decode_al({event_parameter,Item}, SubItem) ->
1074
 
%     i("decode_al({event_parameter,~p}) -> entry with"
1075
 
%       "~n   SubItem: ~p",[Item,SubItem]),
 
1242
decode_al({event_parameter, Item}, SubItem) ->
 
1243
    ?d("decode_al({event_parameter,~p}) -> entry with"
 
1244
       "~n   SubItem: ~p", [Item, SubItem]),
1076
1245
    case Item of
1077
1246
        [16#00,16#04] -> %% Event: on
1078
1247
            case SubItem of
1092
1261
    end;
1093
1262
 
1094
1263
decode_al(signal, SubItem) ->
1095
 
%     i("decode_al(signal) -> entry with"
1096
 
%       "~n   SubItem: ~p",[SubItem]),
 
1264
    ?d("decode_al(signal) -> entry with"
 
1265
       "~n   SubItem: ~p", [SubItem]),
1097
1266
    case SubItem of
1098
1267
        [16#00, 16#02] -> "ri"
1099
1268
    end;
1100
1269
 
1101
 
decode_al({signal_parameter,Item}, SubItem) ->
1102
 
%     i("decode_al({signal_parameter,~p}) -> entry with"
1103
 
%       "~n   SubItem: ~p",[Item,SubItem]),
 
1270
decode_al({signal_parameter, Item}, SubItem) ->
 
1271
    ?d("decode_al({signal_parameter,~p}) -> entry with"
 
1272
       "~n   SubItem: ~p", [Item, SubItem]),
1104
1273
    case Item of
1105
1274
        [16#00,16#02] -> %% Event: ri
1106
1275
            case SubItem of
1191
1360
    case Item of
1192
1361
        "netfail" ->
1193
1362
            case SubItem of
1194
 
                "cs" -> [16#00, 16#06]
 
1363
                "cs" -> [16#00, 16#01]
1195
1364
            end;
1196
1365
        "qualert" ->
1197
1366
            case SubItem of
1218
1387
    case Item of
1219
1388
        [16#00, 16#05] -> % Event netfail
1220
1389
            case SubItem of
1221
 
                [16#00, 16#06] -> "cs"
 
1390
                [16#00, 16#01] -> "cs"
1222
1391
            end;
1223
1392
        [16#00, 16#06] -> % Event qualert
1224
1393
            case Item of
1275
1444
    case Item of
1276
1445
        [16#00, 16#01] -> "pltrans"
1277
1446
    end;
1278
 
decode_rtp({event_parameterm, Item}, SubItem) ->
 
1447
decode_rtp({event_parameter, Item}, SubItem) ->
1279
1448
    case Item of
1280
1449
        [16#00, 16#01] -> % Event pltrans
1281
1450
            case SubItem of
1380
1549
%% ets, e.g., Send(0), Receive(1).
1381
1550
%%----------------------------------------------------------------------
1382
1551
%% 
1383
 
%% C.1.  General Media Attributes
1384
 
%% 
1385
 
%% ________________________________________________________________________
1386
 
%% |PropertyID   | Tag |  Type     |  Value                               |
1387
 
%% |Media        |1001 |Enumeration|Audio(0), Video(1) ,Data(2),          |
1388
 
%% |TransMode    |1002 |Enumeration|Send(0), Receive(1), Send&Receive(2)  |
1389
 
%% |NumChan      |1003 |UINT       | 0-255                                |
1390
 
%% |SamplingRate |1004 |UINT       | 0-2^32                               |
1391
 
%% |Bitrate      |1005 |Integer    |(0..4294967295) Note-units of 100 bit |
1392
 
%% |Acodec       |1006 |Octet str  |Audio Codec Type                      |
1393
 
%% |Samplepp     |1007 |UINT       |Maximum samples/fr per packet:0-65535 |
1394
 
%% |Silencesupp  |1008 |BOOLEAN    |Silence Suppression                   |
1395
 
%% |Encrypttype  |1009 |Octet str  |Ref.: rec. H.245                      |
1396
 
%% |Encryptkey   |100A |Octet str  |SIZE(0..65535) Encryption key         |
1397
 
%% |Echocanc     |100B |Enumeration|Echo Canceller:Off(0),G.165(1),G168(2)|
1398
 
%% |Gain         |100C |UINT       |Gain in db: 0-65535                   |
1399
 
%% |Jitterbuff   |100D |UINT       |Jitter buffer size in ms: 0-65535     |
1400
 
%% |PropDelay    |100E |UINT       |  Propagation Delay: 0..65535         |
1401
 
%% |RTPpayload   |100F |integer    |Payload type in RTP Profile           |
1402
 
%% |_____________|_____|___________|______________________________________|
1403
 
%% 
1404
 
%% 
1405
 
%% C.2.  Mux Properties
1406
 
%% 
1407
 
%% _________________________________________________________________________
1408
 
%% |PropertyID|  Tag       |  Type        |  Value                         |
1409
 
%% |H.221     |  2001      |  Octet string|   H222LogicalChannelParameters |
1410
 
%% |H223      |  2002      |  Octet string|   H223LogicalChannelParameters |
1411
 
%% |V76       |  2003      |  Octet String|   V76LogicalChannelParameters  |
1412
 
%% |H2250     |  2004      |  Octet String|   H2250LogicalChannelParameters|
1413
 
%% |__________|____________|______________|________________________________|
1414
 
%% 
1415
 
%% 
1416
 
%% C.3.  General Bearer Properties
1417
 
%% 
1418
 
%%  _____________________________________________________________________
1419
 
%% | PropertyID|  Tag       |  Type       |  Value                      |
1420
 
%% | Mediatx   |  3001      |  Enumeration|  Media Transport Type       |
1421
 
%% | BIR       |  3002      |  4 OCTET    |  Value depends on transport |
1422
 
%% | NSAP      |  3003      |  1-20 OCTETS|  Ref: ITU X.213 Annex A     |
1423
 
%% |___________|____________|_____________|_____________________________|
1424
 
%% 
1425
 
%% C.4.  General ATM Properties
1426
 
%% 
1427
 
%%    _________________________________________________________________
1428
 
%%   | PropertyID|  Tag |  Type       |  Value                        |
1429
 
%%   | AESA      |  4001|  20 OCTETS  |  ATM End System Address       |
1430
 
%%   | VPVC      |  4002|  2x16b int  |  VPC-VCI                      |
1431
 
%%   | SC        |  4003|  4 bits     |  Service Category             |
1432
 
%%   | BCOB      |  4004|  5b integer |  Broadband Bearer Class       |
1433
 
%%   | BBTC      |  4005|  octet      |  Broadband Transfer Capability|
1434
 
%%   | ATC       |  4006|  Enumeration|  I.371 ATM Traffic Cap.       |
1435
 
%%   | STC       |  4007|  2 bits     |  Susceptibility to clipping   |
1436
 
%%   | UPCC      |  4008|  2 bits     |  User Plane Connection config |
1437
 
%%   | PCR0      |  4009|  24b integer|  Peak Cell Rate CLP=0         |
1438
 
%%   | SCR0      |  400A|  24b integer|  Sustainable Cell Rate CLP=0  |
1439
 
%%   | MBS0      |  400B|  24b integer|  Maximum Burst Size CLP=0     |
1440
 
%%   | PCR1      |  400C|  24b integer|  Peak Cell Rate CLP=0+1       |
1441
 
%%   | SCR2      |  400D|  24b integer|  Sustain. Cell Rate CLP=0+1   |
1442
 
%%   | MBS3      |  400E|  24b integer|  Maximum Burst Size CLP=0+1   |
1443
 
%%   | BEI       |  400F|  Boolean    |  Best Effort Indicator        |
1444
 
%%   | TI        |  4010|  Boolean    |  Tagging                      |
1445
 
%%   | FD        |  4011|  Boolean    |  Frame Discard                |
1446
 
%%   | FCDV      |  4012|  24b integer|  Forward P-P CDV              |
1447
 
%%   | BCDV      |  4013|  24b integer|  Backward P-P CDV             |
1448
 
%%   | FCLR0     |  4014|  8b integer |  Fwd Cell Loss Ratio CLP=0    |
1449
 
%%   | BCLR0     |  4015|  8b integer |  Bkwd P-P CLR CLP=0           |
1450
 
%%   | FCLR1     |  4016|  8b integer |  Fwd Cell Loss Ratio CLP=0+1  |
1451
 
%%   | BCLR1     |  4017|  8b integer |  Bkwd P-P CLR CLP=0+1         |
1452
 
%%   | FCDV      |  4018|  24b integer|  Fwd Cell Delay Variation     |
1453
 
%%   | BCDV      |  4019|  24b integer|  Bkwd Cell Delay Variation    |
1454
 
%%   | FACDV     |  401A|  24b integer|  Fwd Acceptable P-P-P CDV     |
1455
 
%%   | BACDV     |  401B|  24b integer|  Bkwd Acceptable P-P CDV      |
1456
 
%%   | FCCDV     |  401C|  24b integer|  Fwd Cumulative P-P CDV       |
1457
 
%%   | BCCDV     |  401D|  24b integer|  Bkwd Cumulative P-P CDV      |
1458
 
%%   | FCLR      |  401E|  8b integer |  Acceptable Fwd CLR           |
1459
 
%%   | BCLR      |  401F|  8b integer |  Acceptable Bkwd CLR          |
1460
 
%%   | EETD      |  4020|  16b integer|  End-to-end transit delay     |
1461
 
%%   | Mediatx   |  4021|             |  AAL Type                     |
1462
 
%%   | QosClass  |  4022|  Integer    |  0-4 Qos Class                |
1463
 
%%   | AALtype   |  4023|  1 OCTET    |  AAL Type Reference           |
1464
 
%%   |___________|______|_____________|_______________________________|
1465
 
%% 
1466
 
%% 
1467
 
%% C.5.  Frame Relay
1468
 
%% 
1469
 
%%  ______________________________________________________________________
1470
 
%% | PropertyID|  Tag |  Type            |  Value                        |
1471
 
%% | DLCI      |  5001|  Unsigned Integer|  Data link connection id      |
1472
 
%% | CID       |  5002|  Unsigned Integer|  sub-channel id.              |
1473
 
%% | SID       |  5003|  Unsigned Integer|  silence insertion descriptor |
1474
 
%% | Payload   |  5004|  Unsigned Integer|  Primary Payload Type         |
1475
 
%% |___________|______|__________________|_______________________________|
1476
 
%% 
1477
 
%% 
1478
1552
%% C.6.  IP
1479
1553
%% 
1480
1554
%%     ________________________________________________________________
1483
1557
%%    | IPv6      |  6002      |  128 BITS    |  IPv6 Address         |
1484
1558
%%    | Port      |  6003      |  Unsigned Int|  Port                 |
1485
1559
%%    | Porttype  |  6004      |  Enumerated  |  TCP(0),UDP(1),SCTP(2)|
1486
 
%%    | UDP       |  6004      |  Boolean     |                       |
1487
1560
%%    |___________|____________|______________|_______________________|
1488
1561
%%    
1489
 
%% BUGBUG: UDP 6004 should be 6005??
1490
 
%% 
1491
 
%% C.7.  ATM AAL2
1492
 
%% 
1493
 
%% _______________________________________________________________________________
1494
 
%% |PropertyID|  Tag    |  Type         |  Value                                 |
1495
 
%% |AESA      |  7001   |  20 OCTETS    |  AAL2 service endpoint address         |
1496
 
%% |BIR       |  See C.3|  4 OCTETS     |  Served user generated reference       |
1497
 
%% |ALC       |  7002   |  12 OCTETS    |  AAL2 link                             |
1498
 
%% |SSCS      |  7003   |  8..14 OCTETS |  Service specific convergence sublayer |
1499
 
%% |SUT       |  7004   |  1..254 octets|  Served user transport param           |
1500
 
%% |TCI       |  7005   |  BOOLEAN      |  Test connection                       |
1501
 
%% |Timer_CU  |  7006   |  32b integer  |  Timer-CU                              |
1502
 
%% |MaxCPSSDU |  7007   |  8b integer   |  Max. Common Part Sublayer SDU         |
1503
 
%% |SCLP      |  7008   |  Boolean      |  Set Cell Local PriorityLP bit         |
1504
 
%% |EETR      |  7009   |  Boolean      |  End to End Timing Required            |
1505
 
%% |CID       |  700A   |  8 bits       |  subchannel id                         |
1506
 
%% |__________|_________|_______________|________________________________________|
1507
 
%% 
1508
 
%% 
1509
 
%% C.8.  ATM AAL1
1510
 
%% 
1511
 
%% ________________________________________________________________________________
1512
 
%% |PropertyID|  Tag          |  Type         |  Value                            |
1513
 
%% |BIR       |  See Table C.3|  4 OCTETS     |  GIT(Generic Identifier Transport)|
1514
 
%% |AAL1ST    |  8001         |  1 OCTET      |  AAL1 Subtype:                    |
1515
 
%% |8002      |  1 OCTET      |  CBR Rate     |                                   |
1516
 
%% |SCRI      |  8003         |  1 OCTET      |  Source Clock Frequency Recovery  |
1517
 
%% |ECM       |  8004         |  1 OCTET      |  Error Correction Method          |
1518
 
%% |SDTB      |  8005         |  16b integer  |  Structured Data Transfer Blcksize|
1519
 
%% |PFCI      |  8006         |  8b integer   |  Partially filled cells identifier|
1520
 
%% |EETR      |  See Table C.7|  See Table C.7|                                   |
1521
 
%% |__________|_______________|_______________|___________________________________|
1522
 
%% 
1523
 
%% C.9.  Bearer Capabilities
1524
 
%% ________________________________________________________________________
1525
 
%% |PropertyID   |  Tag |  Type       |  Value                            |
1526
 
%% |TMR          |  9001|  1 OCTET    |  Transmission Medium Requirement  |
1527
 
%% |TMRSR        |  9002|  1 OCTET    |  Trans. Medium Requirement Subrate|
1528
 
%% |Contcheck    |  9003|  BOOLEAN    |  Continuity Check                 |
1529
 
%% |ITC          |  9004|  5 BITS     |  Information Transfer Capability  |
1530
 
%% |TransMode    |  9005|  2 BITS     |  Transfer Mode                    |
1531
 
%% |TransRate    |  9006|  5 BITS     |  Transfer Rate                    |
1532
 
%% |MULT         |  9007|  7 BITS     |  Rate Multiplier                  |
1533
 
%% |layer1prot   |  9008|  5 BITS     |  User Information Layer 1 Protocol|
1534
 
%%                                       Reference: ITU Recommendation Q.931 
1535
 
%%                                       Bits 5 4 3 2 1 
1536
 
%%                                       00001   CCITT standardized rate adaption V.110 and X.30. 
1537
 
%%                                       00010 - Recommendation G.711 u-law 
1538
 
%%                                       00011 - Recommendation G.711 A-law 
1539
 
%%                                       00100   Recommendation G.721 32 kbit/s 
1540
 
%%                                       ADPCM and Recommendation I.460. 
1541
 
%%                                       00101 - Recommendations H.221 and H.242 
1542
 
%%                                       00110   Recommendations H.223 and H.245 
1543
 
%%                                       00111   Non-ITU-T standardized rate adaption. 
1544
 
%%                                       01000   ITU-T standardized rate adaption V.120. 
1545
 
%%                                       01001   CCITT standardized rate adaption X.31 
1546
 
%%                                       HDLC flag stuffing. 
1547
 
%%                                       All other values are reserved.           
1548
 
%% |Syncasync    |  9009|  BOOLEAN    |  Synchronous-Asynchronous         |
1549
 
%% |Userrate     |  900B|  5 BITS     |  User Rate Reference              |
1550
 
%% |INTRATE      |  900C|  2 BITS     |  Intermediate Rate                |
1551
 
%% |Nictx        |  900D|  BOOLEAN    |  Tx Network Independent Clock     |
1552
 
%% |Nicrx        |  900E|  BOOLEAN    |  Rx Network independent clock     |
1553
 
%% |Flowconttx   |  900F|  BOOLEAN    |  Tx Flow Control                  |
1554
 
%% |Flowcontrx   |  9010|  BOOLEAN    |  Rx Flow control                  |
1555
 
%% |Rateadapthdr |  9011|  BOOLEAN    |  Rate adapt header-no header      |
1556
 
%% |Multiframe   |  9012|  BOOLEAN    |  Multiple frame estab.            |
1557
 
%% |OPMODE       |  9013|  BOOLEAN    |  Mode of operation                |
1558
 
%% |Llidnegot    |  9014|  BOOLEAN    |  Logical link identifier neg.     |
1559
 
%% |Assign       |  9015|  BOOLEAN    |  Assignor-assignee                |
1560
 
%% |Inbandneg    |  9016|  BOOLEAN    |  In-band or out-band negotiation  |
1561
 
%% |Stopbits     |  9017|  2 BITS     |  Number of stop bits              |
1562
 
%% |Databits     |  9018|  2 BIT      |  Number of data bits              |
1563
 
%% |Parity       |  9019|  3 BIT      |  Parity information               |
1564
 
%% |Duplexmode   |  901A|  BOOLEAN    |  Mode duplex                      |
1565
 
%% |Modem        |  901B|  6 BIT      |  Modem Type                       |
1566
 
%% |layer2prot   |  901C|  5 BIT      |  User info layer 2 protocol       |
1567
 
%% |layer3prot   |  901D|  5 BIT      |  User info layer 3 protocol       |
1568
 
%% |addlayer3prot|  901E|  OCTET      |  Addl User Info L3 protocol       |
1569
 
%% |DialledN     |  901F|  30 OCTETS  |  Dialled Number                   |
1570
 
%% |DiallingN    |  9020|  30 OCTETS  |  Dialling Number                  |
1571
 
%% |ECHOCI       |  9021|  Enumeration|  Echo Control Information         |
1572
 
%% |NCI          |  9022|  1 OCTET    |  Nature of Connection Indicators  |
1573
 
%% |USI          |  9023|  OCTET      |  User Service Information         |
1574
 
%% |             |      |  STRING     |  Reference: ITU Recommendation Q.763 Section 3.57 |
1575
 
%% |_____________|______|_____________|___________________________________|
1576
 
%% 
1577
 
%% 
1578
 
%% C.10.  AAL5 Properties
1579
 
%% 
1580
 
%%  ______________________________________________________________________
1581
 
%% | PropertyID|  Tag    |  Type       |  Value                          |
1582
 
%% | FMSDU     |  A001   |  32b integer|  Forward Maximum CPCS-SDU Size: |
1583
 
%% | BMSDU     |  A002   |  2b integer |  Backwards Maximum CPCS-SDU Size|
1584
 
%% | SSCS      |  See C.7|  See C.7    |  See table C.                   |
1585
 
%% | SC        |  See C.4|  See C.4    |  See table C.4                  |
1586
 
%% |___________|_________|_____________|_________________________________|
1587
1562
%% 
1588
1563
%% C.11.  SDP Equivalents
1589
1564
%% 
1607
1582
%%     |           |      |        |  Reference: IETF RFC 2327       |
1608
1583
%%     |___________|______|________|_________________________________|
1609
1584
%% 
1610
 
%% 
1611
 
%% C.12.  H.245
1612
 
%% 
1613
 
%% ________________________________________________________________________
1614
 
%% |OLC   |  C001|  octet string|  H.245 OpenLogicalChannel structure.    |
1615
 
%% |OLCack|  C002|  octet string|   H.245 OpenLogicalChannelAck structure.|
1616
 
%% |OLCcnf|  C003|  octet string|   OpenLogicalChannelConfirm structure.  |
1617
 
%% |OLCrej|  C004|  octet string|   OpenLogicalChannelReject structure.   |
1618
 
%% |CLC   |  C005|  octet string|   CloseLogicalChannel structure.        |
1619
 
%% |CLCack|  C006|  octet string|   CloseLogicalChannelAck structure.     |
1620
 
%% |______|______|______________|_________________________________________|
1621
 
%% 
1622
1585
%%----------------------------------------------------------------------
1623
1586
 
1624
1587
capabilities_native() ->
1625
1588
    [
1626
 
     {property, "Media"},
1627
 
     {property, "TransMode"},
1628
 
     {property, "NumChan"},
1629
 
     {property, "SamplingRate"},
1630
 
     {property, "RTPpayload"},
 
1589
     %% C.6.  IP 
1631
1590
     {property, "IPv4"},
1632
1591
     {property, "IPv6"},
1633
1592
     {property, "Port"},
1634
1593
     {property, "Porttype"},
1635
 
     {property, "UDP"},
 
1594
 
 
1595
     %% C.11. SDP Equivalents
1636
1596
     {property, "v"},
1637
1597
     {property, "o"},
1638
1598
     {property, "s"},
1648
1608
     {property, "t"},
1649
1609
     {property, "r"},
1650
1610
     {property, "m"}
1651
 
     %% {property, "SDP_V"},
1652
 
     %% {property, "SDP_O"},
1653
 
     %% {property, "SDP_S"},
1654
 
     %% {property, "SDP_I"},
1655
 
     %% {property, "SDP_U"},
1656
 
     %% {property, "SDP_E"},
1657
 
     %% {property, "SDP_P"},
1658
 
     %% {property, "SDP_C"},
1659
 
     %% {property, "SDP_B"},
1660
 
     %% {property, "SDP_Z"},
1661
 
     %% {property, "SDP_K"},
1662
 
     %% {property, "SDP_A"},
1663
 
     %% {property, "SDP_T"},
1664
 
     %% {property, "SDP_R"},
1665
 
     %% {property, "SDP_M"} 
1666
1611
    ].
1667
1612
 
1668
1613
encode_native(Scope, Item) ->
1669
1614
    case Scope of
1670
1615
        property ->
1671
1616
            case Item of
1672
 
                %% General
1673
 
                "Media"        -> [16#10, 16#01];
1674
 
                "TransMode"    -> [16#10, 16#02];
1675
 
                "NumChan"      -> [16#10, 16#03];
1676
 
                "SamplingRate" -> [16#10, 16#04];
1677
 
                "Bitrate"      -> [16#10, 16#05];
1678
 
                "Acodec"       -> [16#10, 16#06];
1679
 
                "Samplepp"     -> [16#10, 16#07];
1680
 
                "Silencesupp"  -> [16#10, 16#08];
1681
 
                "Encrypttype"  -> [16#10, 16#09];
1682
 
                "Encryptkey"   -> [16#10, 16#0a];
1683
 
                "Echocanc"     -> [16#10, 16#0b];
1684
 
                "Gain"         -> [16#10, 16#0c];
1685
 
                "Jitterbuff"   -> [16#10, 16#0d];
1686
 
                "PropDelay"    -> [16#10, 16#0e];
1687
 
                "RTPpayload"   -> [16#10, 16#0f];
1688
 
 
1689
1617
                %% IP
1690
 
                "IPv4"         -> [16#60, 16#01];
1691
 
                "IPv6"         -> [16#60, 16#02];
1692
 
                "Port"         -> [16#60, 16#03];
1693
 
                "Porttype"     -> [16#60, 16#04];
1694
 
                "UDP"          -> [16#60, 16#05];
1695
 
 
1696
 
                %% %% SDP
1697
 
                %% "SDP_V" -> [16#b0, 16#01];
1698
 
                %% "SDP_O" -> [16#b0, 16#02];
1699
 
                %% "SDP_S" -> [16#b0, 16#03];
1700
 
                %% "SDP_I" -> [16#b0, 16#04];
1701
 
                %% "SDP_U" -> [16#b0, 16#05];
1702
 
                %% "SDP_E" -> [16#b0, 16#06];
1703
 
                %% "SDP_P" -> [16#b0, 16#07];
1704
 
                %% "SDP_C" -> [16#b0, 16#08];
1705
 
                %% "SDP_B" -> [16#b0, 16#09];
1706
 
                %% "SDP_Z" -> [16#b0, 16#0a];
1707
 
                %% "SDP_K" -> [16#b0, 16#0b];
1708
 
                %% "SDP_A" -> [16#b0, 16#0c];
1709
 
                %% "SDP_T" -> [16#b0, 16#0d];
1710
 
                %% "SDP_R" -> [16#b0, 16#0e];
1711
 
                %% "SDP_M" -> [16#b0, 16#0f]
 
1618
                "IPv4"     -> [16#60, 16#01];
 
1619
                "IPv6"     -> [16#60, 16#02];
 
1620
                "Port"     -> [16#60, 16#03];
 
1621
                "Porttype" -> [16#60, 16#04];
1712
1622
 
1713
1623
                %% SDP
1714
1624
                "v" -> [16#b0, 16#01];
1733
1643
    case Scope of
1734
1644
        property ->
1735
1645
            case Type of
1736
 
                16#10 ->
1737
 
                    case Item of
1738
 
                        16#01 -> "Media";
1739
 
                        16#02 -> "TransMode";
1740
 
                        16#03 -> "NumChan";
1741
 
                        16#04 -> "SamplingRate";
1742
 
                        16#05 -> "Bitrate";
1743
 
                        16#06 -> "Acodec";
1744
 
                        16#07 -> "Samplepp";
1745
 
                        16#08 -> "Silencesupp";
1746
 
                        16#09 -> "Encrypttype";
1747
 
                        16#0a -> "Encryptkey";
1748
 
                        16#0b -> "Echocanc";
1749
 
                        16#0c -> "Gain";
1750
 
                        16#0d -> "Jitterbuff";
1751
 
                        16#0e -> "PropDelay";
1752
 
                        16#0f -> "RTPpayload"
1753
 
                    end;
1754
 
                16#60->
 
1646
                16#60 ->
1755
1647
                    case Item of
1756
1648
                        16#01 -> "IPv4";
1757
1649
                        16#02 -> "IPv6";
1758
1650
                        16#03 -> "Port";
1759
 
                        16#04 -> "Porttype";
1760
 
                        16#05 -> "UDP"
 
1651
                        16#04 -> "Porttype"
1761
1652
                    end;
 
1653
 
1762
1654
                16#b0 ->
1763
1655
                    case Item of
1764
1656
                        16#01 -> "v";
1776
1668
                        16#0d -> "t";
1777
1669
                        16#0e -> "r";
1778
1670
                        16#0f -> "m"
1779
 
 
1780
 
                        %% 16#01 -> "SDP_V";
1781
 
                        %% 16#02 -> "SDP_O";
1782
 
                        %% 16#03 -> "SDP_S";
1783
 
                        %% 16#04 -> "SDP_I";
1784
 
                        %% 16#05 -> "SDP_U";
1785
 
                        %% 16#06 -> "SDP_E";
1786
 
                        %% 16#07 -> "SDP_P";
1787
 
                        %% 16#08 -> "SDP_C";
1788
 
                        %% 16#09 -> "SDP_B";
1789
 
                        %% 16#0a -> "SDP_Z";
1790
 
                        %% 16#0b -> "SDP_K";
1791
 
                        %% 16#0c -> "SDP_A";
1792
 
                        %% 16#0d -> "SDP_T";
1793
 
                        %% 16#0e -> "SDP_R";
1794
 
                        %% 16#0f -> "SDP_M"
1795
1671
                    end
1796
1672
            end
1797
1673
    end.
1798
1674
 
1799
 
% i(F,A) ->
1800
 
%     i(get(dbg),F,A).
 
1675
%% -------------------------------------------------------------------
1801
1676
 
1802
 
% i(true,F,A) ->
1803
 
%     S1 = io_lib:format("NRES2: " ++ F ++ "~n",A),
1804
 
%     S2 = lists:flatten(S1),
1805
 
%     io:format("~s",[S2]);
1806
 
% i(_,_F,_A) ->
1807
 
%     ok.
 
1677
% error(Reason) ->
 
1678
%     erlang:fault(Reason).
 
1679