bin/engine-di.fm

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 require LWP::Simple;
   8 use Data::Dumper;
   9 require HTTP::Headers;
  10 require HTTP::Request;
  11 require LWP::UserAgent;
  12 require HTTP::Cookies;
  13
  14 my $USERNAME="lace";
  15 my $PASSWORD=&_priv_postget("di.fm.pwd");
  16
  17 delete $ENV{"http_proxy"};
  18
  19 sub _priv_postget($)
  20 {
  21 my($base)=@_;
  22
  23         my $full=$ENV{"HOME"}."/priv/postget.".$base;
  24         local *F;
  25         open F,$full or die "$full: $!";
  26         my $r=do { local $/; <F>; } or die "read \"$full\": $!";
  27         close F or die "close \"$full\": $!";
  28         chomp $r;
  29         return $r;
  30 }
  31
  32 sub paidget($$)
  33 {
  34         my($url,$site)=@_;
  35
  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(
  41                 "POST",
  42                 q{http://}.$site.q{/pro/login.php},
  43                 HTTP::Headers->new(
  44                         "Host"=>$site,
  45                         "Content-Type"=>"application/x-www-form-urlencoded",
  46                 ),
  47                 join('&',
  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()),
  52                         q{remember_login=1},
  53                 ),
  54         );
  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(
  60                 "GET",
  61                 $url,
  62         );
  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());
  66         return $content;
  67 }
  68
  69 if ("build" eq ($ARGV[0]||"")) {
  70         my @symlink;
  71         local $_;
  72         while (<*>) {
  73                 chomp;
  74                 next if !/^(?:\Qdi.fm\E|\Qsky.fm\E)-/;
  75                 -l or next;
  76                 push @symlink,$_;
  77         }
  78         @symlink or die "No existing symlinks found";
  79         my $TARGET="engine-di.fm";
  80         -x $TARGET or die "Target $TARGET not found";
  81
  82         sub sitedump($$)
  83         {
  84                 my($site,$page)=@_;
  85
  86                 my @newdashed;
  87                 while ($page=~m{"((?:http://www.'$site')?([^":]*(?<!_low)[.](?:pls|asx)))"}g) {
  88                         local $_=$1;
  89                         next if m{^/aacplus/};
  90                         next if m{/(?:32|56|64|128)k[.]};
  91                         tr{/}{-};
  92                         push @newdashed,$_;
  93                 }
  94                 @newdashed or die "No URLs found";
  95                 for (@symlink) {
  96                         unlink or die "unlink \"$_\": $!";
  97                 }
  98                 @symlink=();
  99                 for (@newdashed) {
 100                         my $dest="$site$_";
 101                         next if -l $dest;
 102                         symlink $TARGET,$dest or die "symlink \"$dest\": $!";
 103                 }
 104         }
 105
 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;
 112         }
 113         print "OK\n";
 114         exit 0;
 115 }
 116
 117 my $pathslashed=$0;
 118 $pathslashed=~s{^.*/}{};
 119 $pathslashed=~tr{-}{/};
 120 my $streamlisturl="http://$pathslashed";
 121 my $tried;
 122 do {
 123         sub streamlist_get($)
 124         {
 125                 my($streamlist)=@_;
 126
 127                 my @streamlist;
 128                 while ($streamlist=~m{^File\d*\s*=\s*"?(\S+?)"?\s*$}gm) {
 129                         push @streamlist,$1;
 130                 }
 131                 while ($streamlist=~m{<ref\s+href\s*=\s*"(mms://[\S^"]+?)"\s*/>}g) {
 132                         my $url=$1;
 133                         $url=~s{&amp;}{&};
 134                         push @streamlist,$url;
 135                 }
 136                 return @streamlist;
 137         }
 138
 139         my $streamlist=LWP::Simple::get($streamlisturl) or die $streamlisturl;
 140         my @streamlist=streamlist_get $streamlist;
 141         if (!@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";
 146         }
 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";
 152                         $tried++;
 153                         $port||=80;
 154                         warn "Connecting {$host}:{$port}...\n";
 155                         my $tcp=IO::Socket::INET->new(
 156                                 Proto=>"tcp",
 157                                 PeerHost=>$host,
 158                                 PeerPort=>$port,
 159                                 Timeout=>2,
 160                         ) or next;
 161                         close $tcp or die "Close TCP: $!";
 162                 }
 163                 my $mplayer="mplayer";
 164                 my @list=($mplayer);
 165                 if ($pathslashed=~m{/(\d+)k}) {
 166                         push @list,"-cache",60*$1/8,"-cache-min",45;
 167                 }
 168                 push @list,@ARGV;
 169                 push @list,$stream;
 170                 warn Dumper(\@list);
 171                 #system $mplayer @list;
 172                 do { die "[$&] <$_>" if m{[^-a-zA-Z 0-9/:.@=]}; } for @list;
 173                 system {"bash"} "bash","-c",join(" ",@list);
 174                 exit 0 if $?;
 175         }
 176 } while ($tried);