#!/usr/local/bin/perl
############################################################################
# mlurlslave - ed2k://urlslave for mlDonkey                                #
############################################################################
# Version: 1                                                               #
#                                                                          #
# Author:  Veit Wahlich <cru@ircnet.de>                                    #
#                                                                          #
# Descr.:  Little GTK+ enabled Perl script for adding ed2k:// links to     #
#          mlDonkey, designed to implement ed2k:// URL handling into Gnome #
#          (especially Galeon) but might be used for any other purpose.    #
#                                                                          #
# Syntax:  mlurlslave <ed2k:// url>                                        #
############################################################################
# Setting up ed2k://urlslave for mlDonkey and Gnome:                       #
# 1. Copy (root!) mlurlslave to a place in $PATH, I suggest /usr/local/bin #
# 2. Start mlurlslave once to create the default configuration file        #
# 3. Edit the configuration file to fit your needs (~/.mlurlslaverc)       #
# 4. Start gnomecc and open the URL handler capplet                        #
# 5. Fill 'ed2k' into the protocol field and 'mlurlslave "%s"' to the      #
#    handler field                                                         #
# 6. Hit 'set' to add the new protocol handler to the list                 #
# 7. Take any Gnome program (e.g. Galeon) and click some ed2k:// URLs ;)   #
############################################################################

local(%config,$client,$config_file,$true,$false);
$config_file=$ENV{"HOME"}."/.mlurlslaverc";
$false=0;
$true=1;

use IO::Socket;
use Gtk;

sub main{
    my($url);
    %config=&load_config($config_file);
    &check_config();
    $SIG{ALRM}=sub{
	&exit_client($client);
	&show_error("Connection Timeout","Timeout while talking to mldonkey client. See FAQ for possible reasons.");
    };
    $SIG{PIPE}="IGNORE";
    $url=&unhex_url(&get_url(@ARGV));
    &show_error("No URL Transmitted","See README for usage and INSTALL for installation instructions.") if($url eq "");
    &show_error("URL Syntax Error","URL submitted does not start with ed2k:.") if(substr(lc($url),0,5) ne "ed2k:");
    $client=new IO::Socket::INET(PeerAddr=>$config{"host"},PeerPort=>$config{"port"},Type=>SOCK_STREAM,Proto=>"tcp");
    &show_error("Connection Failure","Unable to establish connection: ".$!.". Maybe the FAQ helps you.") unless($client);
    alarm($config{"network_timeout"});
    print($client "auth ".$config{"password"}."\n") unless($config{"password"} eq "");
    print($client "dllink ".$url."\n");
    while(<$client>){
	if(/Bad login\/password/){
	    &exit_client($client);
	    &show_error("Authentication Failure","Unable to log into mldonkey: Wrong password. Hint: ".$config_file);
	}
	elsif(/Command not authorized/){
	    &exit_client($client);
	    &show_error("Authentication Failure","Unable to log into mldonkey: Need to authenticate. Password set? Hint: ".$config_file);
	}
	elsif(/Full access enabled/){
	    $SIG{ALRM}=sub{
		&exit_client($client);
		&show_error("Queue Timeout","Timeout while adding the URL to download to your queue. However the file might have been successfully added, please check. See FAQ for possible reasons.");
	    };
	    alarm($config{"queue_timeout"});
	}
	elsif(/bad syntax/){
	    &exit_client($client);
	    &show_error("URL Syntax Error","URL submitted does not look like a proper ed2k:// URL.");
	}
	elsif(/exception \[DownloadTypes.Already_done\]/){
	    &exit_client($client);
	    &show_error("Already Downloading","You are already downloading this file.");
	}
	elsif(/download started/){
	    &exit_client($client);
	    &show_success("Download Started",$url);
	}
    }
    &exit_client($client)
    &show_error("Terminated Abnormally","The connection to mldonkey client was closed by peer during command traversal. See FAQ for possible reasons.");
}

sub unhex_url{
    # Convert hexadecimal values in URLs 
    my($url)=@_;
    $url=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    $url=~s/[\r\n]/ /g;
    return($url);
}

sub get_url{
    # Join array to space separated string
    return(join(" ",@_));
}

sub exit_client{
    # Close $client if necessary
    my($client)=@_;
    if($client){
	print($client "q\n");
	close($client);
    }
}

sub load_config{
    # Load config file $file and return hash
    my($file)=@_;
    my(%hash);
    &make_default_config($file) unless(-f $file);
    open(IN,"<".$file)||&show_error("Error Loading Config","Unable to load ".$file.": ".$!);
    while(<IN>){
	s/[\r\n]//g;
	my($key,$value)=split(/=/,$_,2);
	$key=&trim_string($key);
	$hash{$key}=&trim_string($value) unless(substr($key,0,1) eq "#" || $key eq "");
    }
    close(IN);
    return(%hash);
}

sub make_default_config{
    # Create default configuration file
    my($file)=@_;
    open(OUT,">".$file)||&show_error("Error Writing Config","Unable to write ".$file.": ".$!);
    print(OUT "###   Configuration file for mlurlslave   ###\n");
    print(OUT "### (C) 2002 Veit Wahlich <cru\@ircnet.de> ###\n");
    print(OUT "\n");
    print(OUT "# The host mldonkey runs on (might be IP addr or hostname):\n");
    print(OUT "host=localhost\n");
    print(OUT "\n");
    print(OUT "# Port number of mldonkey's telnet port:\n");
    print(OUT "port=4000\n");
    print(OUT "\n");
    print(OUT "# Password to use to authenticate against mldonkey:\n");
    print(OUT "password=\n");
    print(OUT "\n");
    print(OUT "# Network timeout in seconds (10 sould be fine on any local network, set higher if you have problems):\n");
    print(OUT "network_timeout=10\n");
    print(OUT "\n");
    print(OUT "# Timeout in seconds for adding a download to the queue (90 sould work for huge files on slow disks):\n");
    print(OUT "queue_timeout=90\n");
    close(OUT);
}

sub check_config{
    # Check if %config includes needed values and set to defaults if not
    $config{"host"}="localhost" unless($config{"host"});
    $config{"port"}=4000 unless($config{"port"});
    $config{"network_timeout"}=10 unless($config{"network_timeout"});
    $config{"queue_timeout"}=90 unless($config{"queue_timeout"});
}

sub trim_string{
    # Cut off leading and ending spaces (and tabs) and return
    my($string)=@_;
    $string=~s/^\s+//;
    $string=~s/\s+$//;
    return($string);
}

sub show_error{
    # Show error window and exit (if GTK did not exit before)
    my($title,$message)=@_;
    &show_window("ed2k://urlslave for mlDonkey",$title."\n\n".$message."\n\n");
    exit(1);
}

sub show_success{
    # Show success window and exit (if GTK did not exit before)
    my($title,$message)=@_;
    &show_window("ed2k://urlslave for mlDonkey",$title."\n\n".$message."\n\n");
    exit(0);
}

sub show_window{
    # GTK window routines, creates a window using $title and $msg
    alarm(0);
    my($title,$msg)=@_;	
    my($window,$button,$label,$vbox);
    init Gtk;
    $window=new Gtk::Window("toplevel");
    $button=new Gtk::Button("OK");
    $window->signal_connect("delete_event",\&close_window);   
    $button->signal_connect("clicked",\&close_window);
    $window->border_width(15);
    $window->set_title($title);
    $window->set_position("center");
    $label=new Gtk::Label($msg);
    $label->set_line_wrap($true);
    $vbox=new Gtk::VBox($false,0);
    $vbox->pack_start($label,$false,$false,$false);
    $vbox->pack_start($button,$false,$false,$false);
    $window->add($vbox);
    $window->show_all();
    main Gtk;
    exit(0);
}

sub close_window{
    # GTK exit method for &show_window()
    Gtk->exit(0);
    return($false);
}

&main();
1;