1 # user-apps.tcl --
2 #
3 # Code defines how to spawn apps for various media types
4 #
5 # Copyright (c) 1997-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31 import UserApplication Application RTP/Audio RTP/Video
32
33 #
34 UserApplication private mega_options { prog sspec ofmt } {
35 set sname [join [$prog field_value o] :]
36 set maxsbw [$self get_option megaMaxBW]
37 set sbw [$self get_option megaStartupBW]
38
39 set p [UserApplication set mega_rport_]
40
41 set addr [intoa [lookup_host_addr [$self get_option megaAddrs]]]
42 set ctrlrport [expr $p + 2]
43 set megactrl $addr/60000:$ctrlrport/1
44 set rport $p:$ctrlrport
45 UserApplication set mega_rport_ [expr $p+4]
46
47 set o "-usemega $sname -maxsbw $maxsbw -sbw $sbw -ofmt $ofmt \
48 -megactrl $megactrl -rport $rport -sspec $sspec"
49
50 return $o
51 }
52
53 #
54 UserApplication private map_args { media } {
55 set mapargs ""
56 foreach a [$media attr_value "rtpmap"] {
57 set L [split $a]
58 if {[llength $L] != 2} {
59 $self warn "bogus rtpmap attribute \"$a\""
60 continue
61 }
62 set pt [lindex $L 0]
63 set type [lindex $L 1]
64 append mapargs "-map $pt:$type "
65 }
66 return $mapargs
67 }
68
69 ####################
70 # vat
71 ####################
72
73 UserApplication register_media audio
74 UserApplication register_formats audio PCM DVI GSM LPC
75 UserApplication register_protos audio RTP/AVP
76
77 Class UserApplication/Vat -superclass UserApplication
78
79 UserApplication/Vat instproc name {} {
80 return "vat"
81 }
82
83 UserApplication/Vat instproc match {prog} {
84 # don't use vat if using unified vic unless there is no video
85 set app [Application instance]
86 set v [[$prog base] media "video"]
87 if {[llength $v] > 0 && [$app yesno unifiedVic]} { return "" }
88
89 set title [$prog field_value s]
90 set cmds {}
91 set media [[$prog base] media "audio"]
92 set i 0
93 foreach m $media {
94 set mapargs [$self map_args $m]
95
96 set port [$m set port_]
97 set caddr [$m set caddr_]
98 set l [split $caddr "/"]
99 if {[llength $l] == 1} {
100 set addr $caddr
101 set ttl 1
102 } else {
103 set addr [lindex $l 0]
104 set ttl [lindex $l 1]
105 }
106 if { [$self get_option megaAddrs] == "" } {
107 set cmd "vat -C \"$title\" $mapargs -t $ttl $addr/$port"
108 } else {
109 set spec $addr/$port/$ttl
110 # XXX
111 set ofmt gsm
112 set mega_args [$self mega_options $prog $spec $ofmt]
113 set cmd "vat -C \"$title\" $mapargs $mega_args"
114 }
115
116 set description "vat audio tool"
117 if {[llength $media] > 1} {
118 if [$media have_field i] {
119 append description " for stream [$media field_value i]"
120 } else {
121 append description " for stream $i"
122 }
123 incr i
124 }
125 lappend cmds [list $description $cmd]
126
127 }
128 return $cmds
129 }
130
131 ####################
132 # vic
133 ####################
134
135 UserApplication register_media video
136 UserApplication register_formats video JPEG H261 PVH
137 #UserApplication register_formats video JPEG H.261 PVH
138 UserApplication register_protos video RTP/AVP
139 UserApplication register_attrs video {scuba {}}
140
141 Class UserApplication/Vic -superclass UserApplication
142
143
144 UserApplication/Vic private mega_options { msg sspec ofmt mrec mtype} {
145 if { $mtype != "video" } {
146 return ""
147 }
148 # video
149 set o "[$self next $msg $sspec $ofmt]"
150 if ![$mrec have_attr scuba] {
151 set o "$o -scuba"
152 }
153 return $o
154 }
155
156 #
157 # Returns a short name for the application.
158 #
159 UserApplication/Vic instproc name {} {
160 return "vic"
161 }
162
163 #
164 # Returns a list of commands (suitable for passing to the tcl
165 # <i>exec</i> procedure) that might be run for this program.
166 #
167 UserApplication/Vic instproc match {prog} {
168 set title [$prog field_value s]
169 set app [Application instance]
170
171 set aspec ""
172 if [$app yesno unifiedVic] {
173 set a [[$prog base] media "audio"]
174 if {[llength $a] > 1} {
175 puts stderr "warning: multiple audio sessions are present."
176 }
177
178 if {[llength $a] > 0} {
179 # get audio parameters
180 set am [lindex $a 0]
181 set aport [$am set port_]
182 set aaddr [lindex [split [$am set caddr_] "/"] 0]
183 set aspec "-a $aaddr/$aport"
184 }
185 }
186
187 set cmds {}
188
189 # rendezvous channel
190 set rspec ""
191 set rend [[$prog base] media "data"]
192 if {[llength $rend] > 0} {
193 set rm [lindex $rend 0]
194 set rport [$rm set port_]
195 set raddr [lindex [split [$rm set caddr_] "/"] 0]
196 set rspec "-rendez $raddr/$rport"
197 }
198
199 set media [[$prog base] media "video"]
200 set i 0
201 foreach m $media {
202 set cmd "vic -C \"$title\" [$self map_args $m]"
203
204 set f [lindex [$m set fmt_] 0]
205 if [catch {RTP/Video set default_ptoa_($f)} fmt] {
206 set fmt "fmt-$f"
207 }
208
209 set port [$m set port_]
210 set caddr [$m set caddr_]
211 set l [split $caddr "/"]
212 set len [llength $l]
213 set addr [lindex $l 0]
214 set ttl 1
215 set count 1
216 if {$len > 1} {
217 set ttl [lindex $l 1]
218 }
219
220 if {$len > 2} {
221 set count [lindex $l 2]
222 }
223
224 set spec "$addr/$port/$fmt/$ttl/$count"
225 foreach msg [$prog set msgs_] {
226 #XXX
227 if {$msg == [$prog base] } { continue }
228
229 set m [$msg media "video"]
230 if {[llength $m] != 1} {
231 $self warn "layered stream with multiple video streams"
232 set m [lindex $m 0]
233 }
234 set port [$m set port_]
235 set caddr [[lindex $m 0] set caddr_]
236 set l [split $caddr "/"]
237 set len [llength $l]
238 set addr [lindex $l 0]
239 set count 1
240 set ttl 1
241 if {$len > 1} {
242 set ttl [lindex $l 1]
243 }
244 if {$len > 2} {
245 set count [lindex $l 2]
246 }
247 append spec ",$addr/$port/$fmt/$ttl/$count"
248 }
249
250 #mega
251 if {[$m have_attr scuba] && [$m attr_value scuba]} {
252 append cmd " -scuba "
253 }
254 if { [$self get_option megaAddrs] == "" } {
255 if {[$m have_attr scuba] && [$m attr_value scuba]} {
256 set b [expr 1000*[$m attr_value scuba]]
257 append cmd " -maxsbw $b "
258 }
259 append cmd " $aspec $rspec $spec"
260 } else {
261 set spec $addr/$port/$ttl
262 # XXX
263 set ofmt h261
264 append cmd " [$self mega_options $prog $spec $ofmt $m video]"
265 }
266
267 set description "vic video tool"
268 if {[llength $media] > 1} {
269 if [$media have_field i] {
270 append description " for stream [$media field_value i]"
271 } else {
272 append description " for stream $i"
273 }
274 incr i
275 }
276 lappend cmds [list $description $cmd]
277 }
278
279 return $cmds
280 }
281
282 ####################
283 # mim
284 ####################
285
286 Class UserApplication/Mim -superclass UserApplication
287 UserApplication/Mim instproc name {} { return "mim" }
288
289 UserApplication/Mim instproc match { prog } {
290 set message [$prog base]
291
292 set video ""
293 set media [lindex [$message media "video"] 0]
294
295 # look for payload type 32 (mpeg)
296 if { $media != "" && [lsearch [$media set fmt_] 32] != -1 } {
297 set port [$media set port_]
298 set addr [$media set caddr_]
299 set addr [lindex [split $addr /] 0]
300 set video "-v $addr $port"
301 }
302
303 set audio ""
304 set media [lindex [$message media "audio"] 0]
305
306 # look for payload type 14 (mpeg audio)
307 if { $media != "" && [lsearch [$media set fmt_] 14] != -1 } {
308 set port [$media set port_]
309 set addr [$media set caddr_]
310 set addr [lindex [split $addr /] 0]
311 set audio "-a $addr $port"
312 }
313
314 if { $audio == "" && $video == "" } { return "" }
315
316 set cmd "mim"
317 if { $audio == "" } {
318 append cmd " -noaudio"
319 } else {
320 append cmd " $audio"
321 }
322 if { $video == "" } {
323 append cmd " -novideo"
324 } else {
325 append cmd " $video"
326 }
327
328 set app [list "MIM MPEG Player" $cmd]
329 return [list $app]
330 }
331
332
333 ####################
334 # mb
335 ####################
336
337 UserApplication register_media whiteboard
338 UserApplication register_protos whiteboard udp
339 UserApplication register_formats whiteboard mb wb
340
341 Class UserApplication/MB -superclass UserApplication
342
343 #
344 # Returns a short name for the application.
345 #
346 UserApplication/MB instproc name {} {
347 return "mb"
348 }
349
350 #
351 # Returns a list of commands (suitable for passing to the tcl
352 # <i>exec</i> procedure) that might be run for this program.
353 #
354 UserApplication/MB instproc match {prog} {
355 set title [$prog field_value s]
356 set cmds {}
357 set media [[$prog base] media "whiteboard"]
358 set i 0
359 foreach m $media {
360 set port [$m set port_]
361 set caddr [$m set caddr_]
362 set fmt [lindex [$m set fmt_] 0]
363 set l [split $caddr "/"]
364 if {[llength $l] == 1} {
365 set addr $caddr
366 set ttl 1
367 } else {
368 set addr [lindex $l 0]
369 set ttl [lindex $l 1]
370 }
371
372 if {$fmt == "wb"} {
373 set cmd "wb -C \"$title\" -t $ttl $addr/$port"
374 } elseif { [$self get_option megaAddrs] == "" } {
375 set cmd "mb -C \"$title\" -sa $addr/$port/$ttl"
376 } else {
377 set spec $addr/$port/$ttl
378 set cmd "mb -C \"$title\" [$self mega_options $prog $spec null]"
379 }
380 set description "mb mediaboard tool"
381 if {[llength $media] > 1} {
382 if [$media have_field i] {
383 append description " for stream [$media field_value i]"
384 } else {
385 append description " for stream $i"
386 }
387 incr i
388 }
389 lappend cmds [list $description $cmd]
390 }
391 return $cmds
392 }
393
394
395 ####################
396 # collaborator
397 ####################
398
399 Class UserApplication/Collaborator -superclass UserApplication
400
401 UserApplication/Collaborator instproc name {} { return "collaborator" }
402
403 #
404 # collaborator will only appear as an option if the session has at least one of
405 # the three possible streams (audio, video, and mediaboard).
406 # It is just launched with minimal arguments for now; stuff like mega,
407 # dynamic rtp payload types, etc.. won't work.
408 #
409 UserApplication/Collaborator instproc match {prog} {
410 set options [$self generate_options $prog]
411
412 if { $options == "" } {
413 return ""
414 } else {
415 set description "collaborator integrated mash tool"
416 append cmd "collaborator $options"
417
418 if { [$self get_option megaAddrs] != "" } {
419 set spec $addr/$port/$ttl
420 set mega_args [$self mega_options $prog]
421 append cmd " $mega_args"
422 }
423 return [list [list $description $cmd]]
424 }
425 }
426
427 #
428 # Returns a list of options to supply to the collaborator application.
429 #
430 UserApplication/Collaborator public generate_options {prog} {
431 set title [$prog field_value s]
432 set sdp_message [$prog base]
433
434 #XXX
435 set video [lindex [$sdp_message media "video"] 0]
436 set audio [lindex [$sdp_message media "audio"] 0]
437 set whiteboard [lindex [$sdp_message media "whiteboard"] 0]
438 if { $whiteboard!={} } {
439 if { [lindex [$whiteboard set fmt_] 0]!="mb" } {
440 set whiteboard {}
441 }
442 }
443
444 set video_options [$self video2options $video]
445 set audio_options [$self audio2options $audio]
446 set mb_options [$self mb2options $whiteboard]
447 append media_options "$video_options $audio_options $mb_options"
448
449 if { $video_options=={} && $audio_options=={} && $mb_options=={} } {
450 return ""
451 } else {
452 return "-C \"$title\" $media_options"
453 }
454 }
455
456
457 UserApplication/Collaborator instproc mega_options prog {
458 # XXX: not implemented
459 return ""
460 }
461
462
463
464 #
465 # Modelled after UserApplication/Vic::match
466 # Returns {} if media does not exist.
467 #
468 UserApplication/Collaborator private video2options { video } {
469 if { $video == {} } {
470 return {}
471 }
472
473 set f [lindex [$video set fmt_] 0]
474 if [catch {RTP/Video set default_ptoa_($f)} fmt] {
475 set fmt "fmt-$f"
476 }
477
478 set port [$video set port_]
479 set caddr [$video set caddr_]
480 set l [split $caddr "/"]
481 set len [llength $l]
482 set addr [lindex $l 0]
483 set ttl 1
484 set count 1
485 if {$len > 1} {
486 set ttl [lindex $l 1]
487 }
488 set spec "$addr/$port/$fmt/$ttl"
489
490 if {[$video have_attr scuba] && [$video attr_value scuba]} {
491 append cmd " -scuba "
492 }
493 if {[$video have_attr scuba] && [$video attr_value scuba]} {
494 set b [expr 1000*[$video attr_value scuba]]
495 append cmd " -vsbw $b "
496 }
497 append cmd " -video $spec "
498
499 return $cmd
500 }
501
502 #
503 # Modelled after UserApplication/Vat::match
504 # Returns {} if media does not exist.
505 #
506 UserApplication/Collaborator private audio2options { audio } {
507 if { $audio == {} } {
508 return {}
509 }
510
511 set port [$audio set port_]
512 set caddr [$audio set caddr_]
513 set l [split $caddr "/"]
514 if {[llength $l] == 1} {
515 set addr $caddr
516 set ttl 1
517 } else {
518 set addr [lindex $l 0]
519 set ttl [lindex $l 1]
520 }
521
522 return "-audio $addr/$port/$ttl"
523 }
524
525 #
526 # Modelled after UserApplication/MB::match
527 # Returns {} if media does not exist.
528 #
529 UserApplication/Collaborator private mb2options { mb } {
530 if { $mb == {} } {
531 return {}
532 }
533
534 set port [$mb set port_]
535 set caddr [$mb set caddr_]
536 set fmt [lindex [$mb set fmt_] 0]
537 set l [split $caddr "/"]
538 if {[llength $l] == 1} {
539 set addr $caddr
540 set ttl 1
541 } else {
542 set addr [lindex $l 0]
543 set ttl [lindex $l 1]
544 }
545
546 return "-mb $addr/$port/$ttl"
547 }
548
549
550 ####################
551 # recorder
552 ####################
553
554 Class UserApplication/Recorder -superclass UserApplication
555
556 UserApplication/Recorder instproc name {} { return "recorder" }
557
558 UserApplication/Recorder instproc match {prog} {
559 set streams ""
560 foreach m [[$prog base] set allmedia_] {
561 set addr [lindex [split [$m set caddr_] /] 0]
562 set port [$m set port_]
563 set spec "$addr/$port"
564
565 set media [$m set mediatype_]
566 set proto [$m set proto_]
567 set fmt [lindex [$m set fmt_] 0]
568 if {$media == "whiteboard" && $proto == "udp" && $fmt == "mb"} {
569 append streams " -add \"SRM mediaboard $spec\""
570 } elseif {$proto == "RTP/AVP"} {
571 append streams " -add \"RTP $media $spec\""
572 }
573 }
574 if {$streams == ""} { return {} }
575
576 set cmd "recorder $streams"
577 set dir [$self get_option recordDir]
578 if {$dir != ""} {
579 append cmd " -directory $dir -noinput"
580 }
581
582 return [list [list "mash recording tool" $cmd]]
583 }
584
585
586 ####################
587 # universalclient
588 ####################
589
590 UserApplication register_media data
591 UserApplication register_protos data udp
592 UserApplication register_formats data rendezvous
593
594 # temporarily callout to separate application; can be
595 # integrated into other apps after further development
596
597 Class UserApplication/Ctrl -superclass UserApplication
598
599 UserApplication/Ctrl instproc name {} { return "universalclient" }
600
601 UserApplication/Ctrl instproc match {prog} {
602 set title [$prog field_value s]
603 set base [$prog base]
604 set d [$base media "data"]
605 if {$d != {} && [lindex [$d set fmt_] 0] == "rendezvous"} {
606 set port [$d set port_]
607 set caddr [$d set caddr_]
608 set l [split $caddr "/"]
609 if {[llength $l] == 1} {
610 set addr $caddr
611 set ttl 1
612 } else {
613 set addr [lindex $l 0]
614 set ttl [lindex $l 1]
615 }
616 set spec $addr/$port/$ttl
617 return [list [list \
618 "universal client" "uc -rendez $spec"]]
619 }
620 return ""
621 }
622
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.