bin/engine-di.fm

   1 #! /usr/bin/perl
   2 #
   3 # $Id: engine-di.fm,v 1.7 2008/05/08 09:08:23 lace Exp $
   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://listen.$site)?([^":]*(?<!_low)[.](?:pls|asx)(?:[?]\w+)?)"}g) {
  88                         local $_=$1;
  89                         next if m{^/aacplus/};
  90                         next if m{/(?:32|56|64|128)k[.]};
  91                         tr{/}{-};
  92                         tr{?}{%};
  93                         push @newdashed,$_;
  94                 }
  95                 @newdashed or die $page."\nNo URLs found";
  96                 for (@symlink) {
  97                         unlink or die "unlink \"$_\": $!";
  98                 }
  99                 @symlink=();
 100                 for (@newdashed) {
 101                         my $dest="$site$_";
 102                         next if -l $dest;
 103                         symlink $TARGET,$dest or die "symlink \"$dest\": $!";
 104                 }
 105         }
 106
 107         for my $site (qw(di.fm)) {      # FIXME: sky.fm
 108                 my $freepageurl="http://$site/";
 109                 my $freepage=LWP::Simple::get($freepageurl) or die $freepageurl;
 110                 sitedump $site,$freepage;
 111                 my $paidpage=paidget $freepageurl,$site;
 112                 sitedump $site,$paidpage;
 113         }
 114         print "OK\n";
 115         exit 0;
 116 }
 117
 118 my $pathslashed=$0;
 119 $pathslashed=~s{^.*/}{};
 120 $pathslashed=~tr{-}{/};
 121 $pathslashed=~tr{%}{?};
 122 my $streamlisturl="http://$pathslashed";
 123 my $tried;
 124 do {
 125         sub streamlist_get($)
 126         {
 127                 my($streamlist)=@_;
 128
 129                 my @streamlist;
 130                 while ($streamlist=~m{^File\d*\s*=\s*"?(\S+?)"?\s*$}gm) {
 131                         push @streamlist,$1;
 132                 }
 133                 while ($streamlist=~m{<ref\s+href\s*=\s*"(mms://[\S^"]+?)"\s*/>}g) {
 134                         my $url=$1;
 135                         $url=~s{&amp;}{&};
 136                         push @streamlist,$url;
 137                 }
 138                 return @streamlist;
 139         }
 140
 141         my $streamlist=LWP::Simple::get($streamlisturl) or die $streamlisturl;
 142         my @streamlist=streamlist_get $streamlist;
 143         if (!@streamlist) {
 144                 $streamlist=~m{Digitally Imported :: Login} or die "No streams found (free): $streamlisturl";
 145                 $streamlist=paidget $streamlisturl,"di.fm";     # FIXME: sky.fm
 146                 @streamlist=streamlist_get $streamlist;
 147                 @streamlist or die "No streams found (paid): $streamlisturl: $streamlist";
 148         }
 149         warn Dumper(\@streamlist);
 150         for my $stream (@streamlist) {
 151                 if (my($host,$port)=($stream=~m{^http://(?:[^@]+@)?([^:/@]+)(?::(\d+))?})) {
 152                         # blacklisted: too slow
 153                         next if $host eq "81.92.172.3";
 154                         $tried++;
 155                         $port||=80;
 156                         warn "Connecting {$host}:{$port}...\n";
 157                         my $tcp=IO::Socket::INET->new(
 158                                 Proto=>"tcp",
 159                                 PeerHost=>$host,
 160                                 PeerPort=>$port,
 161                                 Timeout=>2,
 162                         ) or next;
 163                         close $tcp or die "Close TCP: $!";
 164                 }
 165                 my $mplayer="mplayer";
 166                 my @list=($mplayer);
 167                 push @list,qw(-volume 40);
 168                 push @list,"-cache",30*192/8,"-cache-min",45;
 169                 push @list,@ARGV;
 170                 push @list,$stream;
 171                 warn Dumper(\@list);
 172                 #system $mplayer @list;
 173                 do { die "[$&] <$_>" if m{[^-a-zA-Z 0-9/:.@=_?]}; } for @list;
 174                 system {"bash"} "bash","-c",join(" ",@list);
 175                 exit 0 if $?;
 176         }
 177 } while ($tried);