1#!/usr/bin/perl
2
3use strict;
4
5use SWF::Parser;
6use SWF::Element;
7
8if (@ARGV==0) {
9    print STDERR <<USAGE;
10linkext.plx - Parse SWF file and show the URL referred by 'getURL'.
11  perl linkext.plx swfname
12
13USAGE
14
15    exit(1);
16}
17$Data::TemporaryBag::Threshold = 1000;
18
19my $p=SWF::Parser->new('tag-callback' => \&tag);
20$p->parse_file($ARGV[0]);
21
22sub tag {
23    my ($self, $tag, $length, $stream)=@_;
24    my $t = SWF::Element::Tag->new(Tag=>$tag, Length=>$length);
25    my ($tagname) = $t->tag_name;
26
27    return unless
28	          $tagname eq 'DoAction'      or
29	          $tagname eq 'DoInitAction'  or
30		  $tagname eq 'PlaceObject2'  or
31		  $tagname eq 'DefineButton'  or
32		  $tagname eq 'DefineButton2' or
33		  $tagname eq 'DefineSprite';
34
35
36    if ($tagname eq 'DefineSprite') {
37
38# Tags in the sprite are not unpacked here.
39
40	$t->shallow_unpack($stream);
41	$t->TagStream->parse(callback => \&tag);
42	return;
43
44
45    } elsif ($tagname eq 'PlaceObject2') {
46
47# Most of PlaceObject2 tags don't have ClipActions.
48
49	$t->lookahead_Flags($stream);
50	return unless $t->PlaceFlagHasClipActions;
51    }
52
53# unpack the tag and search actions.
54
55    $t->unpack($stream);
56    check_tag($t);
57}
58
59sub check_tag {
60    my ($t, $stream) = @_;
61    my ($tagname) = $t->tag_name;
62
63    for ($tagname) {
64	(/^Do(Init)?Action$/ or /^DefineButton$/) and do {
65	    search_getURL($t->Actions);
66	    last;
67	};
68	/^PlaceObject2$/ and do {
69	    for my $ca (@{$t->ClipActions}) {
70		search_getURL($ca->Actions);
71	    }
72	    last;
73	};
74	/^DefineButton2$/ and do {
75	    for my $ba (@{$t->Actions}) {
76		search_getURL($ba->Actions);
77	    }
78	    last;
79	};
80	/^DefineSprite$/ and do {
81	    for my $tag (@{$t->ControlTags}) {
82		check_tag($tag, $stream);
83	    }
84	    last;
85	};
86    }
87
88}
89
90sub search_getURL {
91    my $actions = shift;
92
93    for my $action (@$actions) {
94	next unless $action->tag_name eq 'ActionGetURL';
95	process_URL($action->UrlString->value);
96    }
97}
98
99sub process_URL {
100    print shift, "\n";
101}
102
103
104