10 require HTTP::Request;
11 require LWP::UserAgent;
12 require HTTP::Cookies;
15 my $PASSWORD=&_priv_postget("di.fm.pwd");
17 delete $ENV{"http_proxy"};
23 my $full=$ENV{"HOME"}."/priv/postget.".$base;
25 open F,$full or die "$full: $!";
26 my $r=do { local $/; <F>; } or die "read \"$full\": $!";
27 close F or die "close \"$full\": $!";
36 my $ua=LWP::UserAgent->new() or die "UA: $!";
37 my $jar=HTTP::Cookies->new() or die "jar: $!";
38 $ua->cookie_jar($jar);
39 push @{$ua->requests_redirectable()},"POST";
40 my $req=HTTP::Request->new(
42 q{http://}.$site.q{/pro/login.php},
45 "Content-Type"=>"application/x-www-form-urlencoded",
48 q{amember_login=}.$USERNAME,
49 q{amember_pass=}.$PASSWORD,
50 q{refer_back_url=http://}.$site.q{/},
51 q{login_attempt_id=}.(0+time()),
55 my $resp=$ua->request($req) or die "resp(0): $!";
56 die "!success(0)" if !$resp->is_success();
57 die "!content(0)" if !(my $content=$resp->content());
58 $content=~m{You will be redirected to protected area} or die $content;
59 $req=HTTP::Request->new(
63 $resp=$ua->request($req) or die "resp(1): $!";
64 die "!success(1)" if !$resp->is_success();
65 die "!content(1)" if !($content=$resp->content());
69 if ("build" eq ($ARGV[0]||"")) {
74 next if !/^(?:\Qdi.fm\E|\Qsky.fm\E)-/;
78 @symlink or die "No existing symlinks found";
79 my $TARGET="engine-di.fm";
80 -x $TARGET or die "Target $TARGET not found";
87 while ($page=~m{"((?:http://www.'$site')?([^":]*(?<!_low)[.](?:pls|asx)))"}g) {
89 next if m{^/aacplus/};
90 next if m{/(?:32|56|64|128)k[.]};
94 @newdashed or die "No URLs found";
96 unlink or die "unlink \"$_\": $!";
102 symlink $TARGET,$dest or die "symlink \"$dest\": $!";
106 for my $site (qw(di.fm)) { # FIXME: sky.fm
107 my $freepageurl="http://$site/";
108 my $freepage=LWP::Simple::get($freepageurl) or die $freepageurl;
109 sitedump $site,$freepage;
110 my $paidpage=paidget $freepageurl,$site;
111 sitedump $site,$paidpage;
118 $pathslashed=~s{^.*/}{};
119 $pathslashed=~tr{-}{/};
120 my $streamlisturl="http://$pathslashed";
123 sub streamlist_get($)
128 while ($streamlist=~m{^File\d*\s*=\s*"?(\S+?)"?\s*$}gm) {
131 while ($streamlist=~m{<ref\s+href\s*=\s*"(mms://[\S^"]+?)"\s*/>}g) {
134 push @streamlist,$url;
139 my $streamlist=LWP::Simple::get($streamlisturl) or die $streamlisturl;
140 my @streamlist=streamlist_get $streamlist;
142 $streamlist=~m{Digitally Imported :: Login} or die "No streams found (free): $streamlisturl";
143 $streamlist=paidget $streamlisturl,"di.fm"; # FIXME: sky.fm
144 @streamlist=streamlist_get $streamlist;
145 @streamlist or die "No streams found (paid): $streamlisturl: $streamlist";
147 warn Dumper(\@streamlist);
148 for my $stream (@streamlist) {
149 if (my($host,$port)=($stream=~m{^http://(?:[^@]+@)?([^:/@]+)(?::(\d+))?})) {
150 # blacklisted: too slow
151 next if $host eq "81.92.172.3";
154 warn "Connecting {$host}:{$port}...\n";
155 my $tcp=IO::Socket::INET->new(
161 close $tcp or die "Close TCP: $!";
163 my $mplayer="mplayer";
165 if ($pathslashed=~m{/(\d+)k}) {
166 push @list,"-cache",60*$1/8,"-cache-min",45;
170 #system $mplayer @list;
171 do { die "[$&] <$_>" if m{[^-a-zA-Z 0-9/:.@]}; } for @list;
172 system {"bash"} "bash","-c",join(" ",@list);