Browsing articles tagged with " perl"

irc4sms.pl: I’m in your IRC, SMSing your SMSes

This script is a proof-of-concept that I wanted to try more than anything else. Lightly modelled on bitlbee, it pretends to be an IRC server, and accepts/sends SMSes via a gateway (or a gateway app on your Android phone). It’s very much not a finished product and is known to have memory leaks. It also doesn’t clean up after it’s threads.

This script requires threads, threads::shared and IO::Socket.

Config-wise, it’s fairly straightforward – it’s all done in lines 6-21 of the script source. Set $IRCport and $IRCbind to the IP and TCP port you want the server to listen on. Set $IRCpassword to be the password that the IRC client must submit to connect.

The only part that gets tricky is interacting with the gateway. $SMScommand should be set to a script to pass the SMS off to the gateway for delivery. You can use the variables %TO% and %TEXT% in the script path as parameters – these will be replaced with the recipient and the text of the message respectively before the script is called. This could be a PHP script (“/usr/bin/php send-sms.php %TO% ‘%TEXT%’”), a URL using curl or wget (“/usr/bin/wget http://localhost/cgi-bin/sms.cgi?to=%TO%&text=%TEXT%”), an email address using sendmail or similar (“echo %TEXT% | /usr/sbin/sendmail %TO%@sms.gateway.com”) or anything else you might want to use.

Likewise, receiving SMSes can be a bit tricky. $SMSreceiveKey needs to be set to a key that will be used to ensure that the SMSes are received from the real gateway. SMSes are accepted from the gateway by connecting to the IRC server socket and sending nothing more than:

DELIVER sms-receive-key 1234567890 :SMS text goes here.\r\n

The connection does not have be registered as an IRC client or authenticated to the server. It’s important to note that the IP and port you have set earlier in the configuration must be accessible by whatever is delivering the SMSes as well, or it will not be able to connect. In a lot of cases, SMS gateway services or gateway apps running on your phone will only support email forwarding or HTTP delivery of incoming texts. In either of these cases, I suggest creating a script to deliver the SMS for you. In the former case, a Perl script that gets called by a pipe from the mail server which connects to the server’s socket and deliver’s the SMS would be pretty straightforward. Likewise, a PHP script on a webserver could be configured to accept an SMS by GET/POST parameters and connect to the socket to deliver it.

Use-wise, it’s fairly straightforward. You can type ‘help’ in #sms after connecting for a short summary of this information. When you receive an SMS, the phone number it is received from will join #sms and address the text message to your attention:

* 1234567890 has joined #sms.
<1234567890> your-nickname: Hello there.

You can reply in kind:

<your-nickname> 1234567890: Hiya.

You can also send a text message to a number not presently in the channel the same way – just address the message at the number and SMSbot will ensure it’s delivered for you.

You can also message people by opening a private chat with them – either use ‘/query 123456790′ or double-click their name on the userlist of most IRC clients to open a private chat. Send your message, and replies will automatically be sent back to you in private message. To switch back to receiving their messages in #sms, just message them from the channel again and their replies will go there instead.

Finally, you can use the channel’s userlist as a sort of contact list by adding and removing users from it. When you receive an SMS from someone not already in the channel, they will join. You can also add them to the channel without sending them a message:

<your-nickname> add 1234567890
* 1234567890 has joined #sms.

Likewise, you can remove someone from the channel whether they joined because you added them or because they sent you a message:

<your-nickname> remove 1234567890
* 1234567890 has left #sms.

If you remove someone from the channel, they will join again the next time they send you a message.


Script Source

#!/usr/bin/perl
use IO::Socket;
use threads;
use threads::shared;

##### Config #####

# IRCd settings. At least change the password.
my $IRCport = "21337";
my $IRCbind = "127.0.0.1";
my $IRCpassword = "irc4sms";

# Shell command to send SMSes via gateway.
# Consider using wget or sendmail!
# Variables! %TO% and %TEXT%
my $SMScommand = "/usr/bin/wget http://localhost/cgi-bin/send-sms.cgi?to=%TO%&text=%TEXT%";

# Key to receive inbound SMSes. Change this.
my $SMSreceiveKey = "1rc45m5!";

##### End Config ######

$version = "0.2";
$crlf = "\r\n";

my @msgQueue;
share(@msgQueue);
my %joined;
share(%joined);

$SIG{CHILD} = 'IGNORE';
$SIG{PIPE} = 'IGNORE';

my $listen_socket = IO::Socket::INET->new(
	LocalPort => $IRCport,
	LocalAddr => $IRCbind,
	Listen => 10,
	Proto => 'tcp',
	Reuse => 1
);
$listen_socket->autoflush(1);
die "Can't bind local socket: $!\n" unless $listen_socket;

while(my $connection = $listen_socket->accept){
	my $child = threads->create("read_data", $connection);
}

sub deliver_data {
	my($socket, $nickname) = @_;
	while(1){
		foreach my $message(@msgQueue) {
				my ($sender, $text) = $message =~ /^(.+?)\:(.+)$/;
				if($sender && $text){
						if($joined{$sender} < 1){
								$joined{$sender} = 1;
								print $socket ':'.$sender.' JOIN #sms'.$crlf;
						}
						if($joined{$sender} == 1){ print $socket ':'.$sender.' PRIVMSG #sms :'.$nickname.': '.$text.$crlf; }
						if($joined{$sender} > 1){ print $socket ':'.$sender.' PRIVMSG '.$nickname.' :'.$text.$crlf; }
				}
		}
		@msgQueue = ();
	}
}

sub read_data {
	my($socket) = @_;
	my $registered = 0;

	print $socket ':irc4sms.local NOTICE AUTH :irc4sms ready. Login or deliver an SMS.'.$crlf;
	while(){
		$data = $_;
		print $data;
		$data =~ s/[\r\n]//ig;

		if($data =~ /^PING (.+)$/){
			print $socket ':irc4sms.local PONG irc4sms.local :'.$1.$crlf;
		}

		if($registered < 3){
			if($data =~ /^DELIVER (.+?) (.+?) \:(.+)$/ && $1 eq $SMSreceiveKey){
				$sender = $2;
				$text = $3;
				$sender =~ s/^\+//;
				$msgQueue[++$#msgQueue] = $sender.":".$text;
				print $socket 'MESSAGE OK ('.$sender.'): '.$text.' - Queued for delivery.'.$crlf;
			}elsif($data =~ /^USER (.+?) .+ (?:\:|)(.+)$/){
				$username = $1;
				$realname = $3;
				$registered++;
			}elsif($data =~ /^NICK (.+)$/){
				$nickname = $1;
				print $socket ':irc4sms.local 464 '.$nickname.' :P assword required.'.$crlf;
				$registered++;
			}elsif($data =~ /^PASS (.+)$/){
				if($1 eq $IRCpassword){
					$registered++;
				}else{
					print $socket ':irc4sms.local 464 '.$nickname.' :Invalid password.'.$crlf;
				}
			}

			if($registered == 3){
				print $socket ':irc4sms.local 001 '.$nickname.' :Welcome'.$crlf;
				print $socket ':irc4sms.local 002 '.$nickname.' :Host irc4sms.local is running irc4sms '.$version.$crlf;
				print $socket ':irc4sms.local 003 '.$nickname.' :irc4sms (http://code.cmantito.com/IrcSms)'.$crlf;
				print $socket ':irc4sms.local 004 '.$nickname.' irc4sms.local abiswRo ntC'.$crlf;
				print $socket ':irc4sms.local 005 '.$nickname.' PREFIX=(ohv)@%+ CHANTYPES=# CHANMODES=,,,ntC NICKLEN=25 CHANNELLEN=25 NETWORK=irc4sms SAFELIST CASEMAPPING=rfc1459 MAXTARGETS=1 WATCH=128 :are supported by this server'.$crlf;
				print $socket ':irc4sms.local 375 '.$nickname.' :- irc4sms.local MOTD:'.$crlf;
				print $socket ':irc4sms.local 372 '.$nickname.' :- Welcome to irc4sms '.$version.$crlf;
				print $socket ':irc4sms.local 376 '.$nickname.' :End of MOTD'.$crlf;
				print $socket ':'.$nickname.'!'.$username.'@irc4sms.local MODE cm :+sR'.$crlf;
				print $socket ':'.$nickname.'!'.$username.'@irc4sms.local JOIN :#sms'.$crlf;
				print $socket ':irc4sms.local MODE #sms +Ct'.$crlf;
				print $socket ':irc4sms.local 353 '.$nickname.' = #sms :@'.$nickname.' @SMSbot'.$crlf;
				print $socket ':irc4sms.local 366 '.$nickname.' #sms :End of /NAMES list'.$crlf;
				print $socket ':irc4sms.local 332 '.$nickname.' #sms :irc4sms '.$version.$crlf;
				print $socket ':irc4sms.local 333 '.$nickname.' #sms SMSbot!SMSbot@irc4sms.local '.(time - 60).$crlf;
				$joined{$nickname} = 1;
				$joined{'SMSbot'} = 1;
				my $delivery = threads->create("deliver_data", $socket, $nickname);
			}
		}else{
			if($data =~ /^MODE/){
				print $socket ':irc4sms.local 324 '.$nickname.' #sms +Ct'.$crlf;
			}elsif($data =~ /^WHO/){
				print $socket ':irc4sms.local 352 '.$nickname.' #sms '.$username.' irc4sms.local irc4sms.local '.$nickname.' H@ :0 '.$realname.$crlf;
				print $socket ':irc4sms.local 352 '.$nickname.' #sms irc4sms irc4sms.local irc4sms.local SMSbot H@ :0 irc4sms '.$version.$crlf;
			}elsif($data =~ /^PRIVMSG \#sms \:(.+?)(?:\:|\,) (.+)$/){
				if($joined{$1} > 0){
					$joined{$1} = 1;
				}
				$to = $1;
				$text = $2;
				$cmd = $SMScommand;
				$cmd =~ s/\%TO\%/$to/g;
				$cmd =~ s/\%TEXT\%/$text/g;
				system($cmd);
			}elsif($data =~ /^PRIVMSG ([a-zA-Z0-9\+]+?) \:(.+?)$/){
				if($joined{$1} > 0){
					$joined{$1} = 2;
				}
				$to = $1;
				$text = $2;
				$cmd = $SMScommand;
				$cmd =~ s/\%TO\%/$to/g;
				$cmd =~ s/\%TEXT\%/$text/g;
				system($cmd);
			}elsif($data =~ /^PRIVMSG \#sms :( .+?)$/){
				$command = $1;
				if($command =~ /^add (.+)/ && !$joined{$1} ){
					$joined{$1} = 1;
					print $socket ':'.$1.' JOIN #sms'.$crlf;
				}elsif($command =~ /^remove (.+?)$/ && ($joined{$1})){
					$joined{$1} = '';
					print $socket ':'.$1.' QUIT :Leaving...'.$crlf;
				}elsif($command =~ /^help/){
					print $socket ':SMSbot PRIVMSG #sms :Commands: add 442392123456, remove 442392123456'.$crlf;
					print $socket ':SMSbot PRIVMSG #sms :If you /msg a contact, responses will automatically come as a /msg'.$crlf;
					print $socket ':SMSbot PRIVMSG #sms :Otherwise, address the contact in this channel, and their replies will come here'.$crlf;
				}else{
					print $socket ':SMSbot PRIVMSG #sms :I don\'t recognise that as a valid command. Sorry. Try "help".'.$crlf;
				}
			}
		}
	}
}

checkdupes.pl

Script Information

This script checks files specified on the command line for duplicates based on checksums. Version 0.3a will also highlight files in different directories with the same name. Version 0.2a introduced the capability of recursion using the -a flag. See documentation.

Documentation

Usage: ./checkdupes.pl
At least two or more files must be specified. Any folders
specified will be skipped. Wildcards will work, for example:
     ./checkdupes.pl *
will check all files in the current folder. Likewise:
     ./checkdupes.pl folder/* folder-2/*
will check all files in both those folders. It will not
recurse on it's own.

Alternatively (as of 0.2a), you can pass the -a flag:
      ./checkdupes.pl -a
This will check all files, recursively, starting from the
current working directory.

As of version 0.3a, it will also find files with duplicate
names that reside in different directories. No flag is
necessary to enable this functionality.

Script Source

#!/usr/bin/perl

if($ARGV[0] =~ /\-a/i && !$ARGV[1]){
    system("find --version &>/dev/null");
    if($? != 0){
        print STDERR "FATAL: find not in \$PATH (".$ENV{'PATH'}.") - aborting.\n";
        exit(2);
    }

    $flist = `find ./`;
    @ARGV = split(/\n/, $flist);
}

if(@ARGV[0] =~ /\-(?:h|v|\?)/i || !$ARGV[0] || !$ARGV[1] || ($ARGV[0] =~ /\-a/i && $ARGV[1])){
    print STDERR "\nUsage: ".$0." \n";
    print STDERR "\tAt least two or more files must be specified. Any folders\n";
    print STDERR "\tspecified will be skipped. Wildcards will work, for example:\n";
    print STDERR "\t\t".$0." *\n";
    print STDERR "\twill check all files in the current folder. Likewise:\n";
    print STDERR "\t\t".$0." folder/* folder-2/*\n";
    print STDERR "\twill check all files in both those folders. It will not\n";
    print STDERR "\trecurse on it's own.\n\n";
    print STDERR "\tAlternatively (as of 0.2a), you can pass the -a flag:\n";
    print STDERR "\t\t$0 -a\n";
    print STDERR "\tThis will check all files, recursively, starting from the\n";
    print STDERR "\tcurrent working directory.\n\n";
    print STDERR "\tAs of version 0.3a, it will also find files with duplicate\n";
    print STDERR "\tnames that reside in different directories. No flag is\n";
    print STDERR "\tnecessary to enable this functionality.\n\n";
    print STDERR $0." 0.3a by cmantito \n\n";
    exit(1);
}

system("md5sum --version &>/dev/null");
if($? != 0){
    print STDERR "FATAL: md5sum not in \$PATH (".$ENV{'PATH'}.") - aborting.\n";
    exit(2);
}

$progress = 0;
while($file = shift(@ARGV)){
    print "Processing ".$progress."/".++$#ARGV."...\n";
    if(-e $file){
        if( !-d $file){
            $escfile = $file;
            $escfile =~ s/(.)/\\$1/ig;
            $sum = `md5sum $escfile`;
            $sum =~ s/^(.+?)\s+.+$/\1/ig;
            chomp($sum);
            $sums{$sum}++;
            push(@$sum, $file);

            $filename = $file;
            $filename =~ s/(.+)\/(.+)$/\2/;
            if(!$filenames{$filename}){
                $filenames{$filename} = $file;
            }else{
                $filenames{$filename} .= "¬".$file;
            }
            $filenamecount{$filename}++;
        }
    }else{
        print STDERR "FATAL: Couldn't open file: ".$file." - aborting.\n";
        exit(1);
    }
    $progress++;
}

print "\n--- DUPLICATE FILES ---\n";
foreach $sum(keys %sums){
    if($sums{$sum} > 1){
        print $sum.": ";
        foreach $file(@$sum){
            print $file." ";
        }
        print "\n";
    }
}
print "\n--- DUPLICATE NAMES ---\n";
foreach $filename(keys %filenamecount){
    if($filenamecount{$filename} > 1){
        print $filename.": ";
        $filelist = $filenames{$filename};
        $filelist =~ s/¬/ /ig;
        print $filelist."\n";
    }
}

print "\n";
exit(0);

Useful one-liners

If you have a couple dozen DSCxxxx.jpg photos that you need to be renamed sequentially (or any file for that matter), like I often do, this’ll do..
(change $c.jpg to whatever extension the files should end in, you can also apply arguments to ls -1 as necessary.)

f=$(ls -1); c=0; for i in $f; do mv $i $c.jpg; c=$(echo $c + 1 | bc); done

Strip large chunks of pesky comments from dist-default sample config files:

cat httpd.conf | perl -e 'while($a=<STDIN>){if($a !~ /^\s*#/){if($a ne "\n"){print $a;}}}' >httpd.conf.nocomments

tinyurlfs, file2tinyurl & tinyurl2file

IRC Log (or, initial idea conception)

<Ignite> :)
<cmantito> ok, this is gonna sound crazy
<cmantito> really, really crazy
<cmantito> as you might have (or not) seen when it was in the /t, I wrote a set of scripts that could encode files
as URLs to be stored in a tinyurl, and then extracted again
<LeaChim> yes, that was quite cool
<cmantito> now, I'm writing a mountable filesystem, when you copy a file into it, it uploads it to tinyurl, grabs
the tinyurlid, and passes it to a PHP API running on my server and it stores the filename and the tinyurl ID
<LeaChim> why a php script?
<LeaChim> why can't it store this locally?
<cmantito> I'm getting there ;)
<cmantito> and when you read a file, it queries the API running on my server with the filename, gets the urlID, and
allows you to open the file in place
<cmantito> ideally, it's a write-once filesystem, you can put files into it, but not remove them, overwrite them, or
modify them.
<cmantito> the reason for using a remote API for it, is so that it's a unified filesystem
<cmantito> ie, I copy a file into it, and you can copy it right back out again
<cmantito> it's a giant filestore!
<LeaChim> heh
<cmantito> for *everyone*
<LeaChim> quite cool
<cmantito> and
<cmantito> if someone wants to bitch at me for "storing" files of naughty materials
<cmantito> I can use the bittorrent defense
<cmantito> "I only store metadata"
<Ignite> rofl
<LeaChim> heh
<LeaChim> well, you'll be implemented this as fuse right?
<cmantito> yes.
<cmantito> it's half-done
<Ignite> cmantito, so like
<Ignite> cmantito, we can all use it?
<cmantito> yes :D
<Ignite> So we can sort of share warez and shits?
<Ignite> :x
<cmantito> if the links are already in the database, it can read them and list them
<LeaChim> cmantito, for rmdir unlink rename chmod chown truncate you should just return permission denied
<cmantito> LeaChim: exactly! :D
<cmantito> fserr(13)
<cmantito> ENOACCES
<LeaChim> so all you've got left are mkdir symlink link utime, and file creation
<cmantito> well those 4 are unnecessary
<LeaChim> in fact, you might as well not have symlink or link
<LeaChim> no, keep mkdir
<cmantito> exactly
<cmantito> no, it's a flat filesystem
<Ignite> No
<LeaChim> boring
<Ignite> mkdir
<LeaChim> and horrible to list
<Ignite> WE WANT MKDIR
<LeaChim> add mkdir
* Ignite chants
<cmantito> ffs *fine*
<LeaChim> besides, mkdir is just php side
<Ignite> Rofl
<cmantito> now it's gonne take even longer.
<Ignite> xD
<cmantito> I *was* trying to keep it relatively simple
<cmantito> since if it takes off, tinyurl will kinda notice
<cmantito> Upload a DVD image "What's that, a 4.93921239x10^9 character URL!?"
<cmantito> actaully more
<cmantito> uuencode pads.
<cmantito> butokfine
<LeaChim> cmantito, you might want to add some code to allow you to split up files
<cmantito> I'll put in the ability to add one level of directories.
<cmantito> ONE XD
<LeaChim> lol
<LeaChim> why not more than one?
<LeaChim> it's just going to get horrible to list directories ;
<LeaChim> and maybe you should add something to expire things, so the directory listing doesn't end up being
gigantic
<cmantito> I'm trying to limit the amount of HTTP queries I have to make for any given requests.
<cmantito> s/(request)s/\1/

Original Scripts

The original file2tinyurl and tinyurl2file scripts were originally published at RackLoad (now defunct) and then at the Xelix wiki, followed by my own CodeWiki to continue development into a FUSE mountable filesystem. They now live here, source available below.

Development Roadmap

It actually works. By using file2tinyurl, and then putting the relevant values into the database manually. the files are accessible. It is not directory-structured yet, and file upload isn’t complete yet either. Please keep adding feature requests, and as soon as a usable version (even without ALL the features) is alpha, I’ll chuck it up here.

Original Proof of Concept Source

These scripts requires the following Perl modules:

  • LWP::UserAgent
  • Convert::UU
  • HTML::Entities
  • URI::Escape

These modules all have dependencies of their own. To easily install the modules and all their dependencies, execute the following command as root and it will prompt you to install the dependencies. Pressing return repeatedly will generally suffice.

cpan install LWP::UserAgent Convert::UU HTML::Entities URI::Escape

file2tinyurl
Purpose
This script will upload a file to TinyURL. Yeah, you heard that right.

Theory
TinyURL takes a given URL, and sticks it, with a pointer, into it’s database. Why does the URL have to be a URL? It could be any text. Well why not binary data? Just encode the binary data as text, like your mail client does every time you send a binary attachment, and upload that. This script does that for you, too. Then you just need a way to get it out again. See the next post.

What this script does

  1. When given a path to a file name, this will:
  2. Read the file
  3. UUencode the data in the file, converting it to “safe” ASCII.
  4. Strip the newlines from that, since UUencoded data is set at a certain width, and replace them with flags.
  5. Escape and non-URL safe text in the %xx form (ie, ‘~’ becomes %7E, ‘ ‘ becomes %20).
  6. POST the data to TinyURL, and strip the TinyURL and TinyURL ID from the results, displaying it to a console.

As of yet, I have not found a length limit on the original URLs that TinyURL will shorten. Therefore, as of yet, I have not found a filesize limit for “uploaded” files.

Source: file2tinyurl.pl

#!/usr/bin/perl

### This script was written by cmantito
### cmantito@cmantito.com
### http://cmantito.com
### This script can be freely modified/distributed/used and is open-source.
### However, I'd appreciate some credit on derivative works.

use LWP::UserAgent;
use Convert::UU qw(uudecode uuencode);
use HTML::Entities;
use URI::Escape;

## If this script runs with strict, you're fucked. So don't add strict.

$filename = shift(@ARGV);

if(!$filename){
   print "Usage: file2tinyurl /path/to/file\n";
   exit(15);
}

$relFn = $filename;
$relFn =~ s/^(.+)\///ig;

if((-e $filename) && (-r $filename)){
   if(-d $filename){
      fatal("Specified file must not be a directory.");
   }
}else{
   fatal("Specified file doesn't exist or isn't readable.");
}

open(TUFILE, "){
   $rawData .= $_;
}
close(TUFILE);

$uuData = uuencode($rawData);
$uuData =~ s/\n/_NWLN_/ig;

$urlData = uri_escape($uuData);

$url = "http://".$relFn."/".$urlData;
$formData{'url'} = $url;
$formUrl = "http://tinyurl.com/create.php";

$browser = LWP::UserAgent->new;
$response = $browser->post($formUrl, Content => \%formData);

if($response->is_success){
   $tinyData = $response->content;
   ($tinyId) = $tinyData =~ /\http:\/\/tinyurl\.com\/(.+?)\/;
   print "File uploaded successfully.\n";
   print "TinyURL ID (used with tinyurl2file for download): ".$tinyId."\n";
   print  "TinyURL (for reference): http://tinyurl.com/".$tinyId."\n";
   exit(0);
}else{
   print $formUrl;
   fatal("Couldn't contact TinyURL: ".$response->status_line);
}

sub fatal {
   $errorString = shift(@_);
   print STDERR "Fatal error: ".$errorString."\n";
   exit(5);
}

tinyurl2file
Purpose
This script will download a file that was uploaded to TinyURL with file2tinyurl.

Theory
TinyURL takes a given URL, and sticks it, with a pointer, into it’s database. Why does the URL have to be a URL? It could be any text. Well why not binary data? Just encode the binary data as text, like your mail client does every time you send a binary attachment, and upload that. Then you just need a way to get it out again. And this is that portion of it. ^_^

What this script does

  1. When given a TinyURL ID (the part of the TinyURL after the tinyurl.com/),
  2. Retrieves the preview page (preview.tinyurl.com/)
  3. Strips the “original URL” portion out of the page
  4. Extracts the original filename from our “URL”
  5. Looks for newline flags, and puts them back where they belong
  6. Gets rid of any HTML entities, replacing them with the correct ASCII (ie, < should be < and & should be &)
  7. Converts the URL-encoded characters back to ASCII (ie, %20 becomes a space, %7E becomes a ‘~’)
  8. Un-UUencodes the ASCII, getting it back to it’s original form (likely binary data)
  9. Writes that back out to a file, using the original file’s filename which was encoded into it with file2tinyurl.

Source: tinyurl2file.pl

#!/usr/bin/perl

### This script was written by cmantito
### cmantito@cmantito.com
### http://cmantito.com
### This script can be freely modified/distributed/used and is open-source.
### However, I'd appreciate some credit on derivative works.

use LWP::UserAgent;
use Convert::UU qw(uudecode uuencode);
use HTML::Entities;
use URI::Escape;

## If this script runs with strict, you're fucked. So don't add strict.

$urlId = shift(@ARGV);

if(!$urlId){
   print "Usage: tinyurl2file [TinyURL ID from file2tinyurl]\n";
   exit(15);
}

$tinyUrl = "http://preview.tinyurl.com/".$urlId;

$browser = LWP::UserAgent->new;
$response = $browser->get($tinyUrl);

if($response->is_success){
   $tinyData = $response->content;
}else{
   fatal("Couldn't contact TinyURL: ".$response->status_line);
}

($uuUrl) = $tinyData =~ /\
\(.+?)\
\<\/b\>\<\/blockquote\>/; $uuUrl =~ s/\
//ig; ($filename, $uuData) = $uuUrl =~ /http:\/\/(.+?)\/(.+)$/; $uuData =~ s/_NWLN_/\n/ig; $uuData = decode_entities($uuData); $rawData = uri_unescape($uuData); $rawData = uudecode($rawData); open(TUFILE, ">".$filename) or fatal($!); print TUFILE $rawData; close(TUFILE); print "File downloaded to ./".$filename."\n"; sub fatal { $errorString = shift(@_); print STDERR "Fatal error: ".$errorString."\n"; exit(5); }

Palm Centro Bluetooth Enabler

Script Information
I recently owned a Palm Centro (although I no longer do and now I do yet again), which is a nice device except for the part where it lacks Wifi connectivity. To combat this problem, I put together a script that allows me to connect to the computer from the Centro using bluetooth, and have my computer act as a router for the unit, allowing it to get on the internet over the bluetooth connection.

It uses AppleScript and Perl, and has three parts. It can be easily modified to work on Linux.

BluetoothEnabler.scpt

set mypath to POSIX path of (path to me)
set interfaces to do shell script "/bin/bash '" & mypath & "Contents/Resources/Scripts/getinterfaces.sh'"
set ttys to do shell script "/bin/bash '" & mypath & "Contents/Resources/Scripts/getttys.sh'"

set interfacedialog to display dialog "Which interface is connected to the internet?

(Interfaces on this system: " & interfaces & ")" default answer "en1"

set syncttydialog to display dialog "Which serial port is the Bluetooth PDA sync port?

(Ports on this system: " & ttys & ")" default answer "Bluetooth-PDA-Sync"

set sharettydialog to display dialog "Which serial port is the Bluetooth modem sharing port?

This should have been added by you before running this script. If you haven't done this, click cancel, open Bluetooth preferences, go to advanced, and add a new, non-secure port of type Modem, then re-run this enabler and put it's name in this dialog.

Ports on this system: " & ttys & ")" default answer "sharing-port"

set theinterface to the text returned of interfacedialog
set thesynctty to the text returned of syncttydialog
set thesharetty to the text returned of sharettydialog

display dialog "The enabler will now run, starting a PPP server on " & thesynctty & " and " & thesharetty & ", directing packets between them, using " & theinterface & " as a default gateway. It will enable kernel-level packet forwarding and NAT.

This needs to be run each time the system is booted before the Palm will be able to connect, and not more than once.

It will require your password to run, and it may take a short time to complete. Configuration instructions for your handheld will be displayed when it is complete."

do shell script "sudo /usr/sbin/pppd /dev/tty." & thesynctty & " 115200 noauth local
  passive proxyarp asyncmap 0 silent persist :10.0.1.201 &" with administrator privileges
do shell script "sudo /usr/sbin/sysctl -w net.inet.ip.forwarding=1" with administrator privileges
do shell script "sudo /usr/sbin/natd -same_ports -use_sockets -log -deny_incoming -interface " & theinterface with administrator privileges
do shell script "sudo /sbin/ipfw add divert natd ip from any to any via " & theinterface with administrator privileges
do shell script "sudo /usr/sbin/pppd /dev/tty." & thesharetty & " 115200 noauth local passive proxyarp asyncmap 0 silent persist :10.0.1.202 &" with administrator privileges

display dialog "The enabler has run. You can now try to connect from your Palm. Your Palm should be paired to this computer.

The Palm should be configured with a connection profile set to 'Connect to PC via Bluetooth', and the device should be set to your computer. Under details, you will need to set the spped to 115,200 bps, and the Flow Ctl to automatic.

You will also need to create a new network profile, set to use the connection you just created. No username or password is necessary. Under details, the idle timeout should be set to never, and under advanced, specify an IP address of 10.0.1.201. You may use whatever DNS servers you like, reccomended are 4.2.2.1 and 4.2.2.2.

Once this is configured you should be able to connect."

getinterfaces.sh

#!/bin/bash

ifconfig | perl -e 'while($line=<STDIN>){($int)=$line=~/^(\w+\d):/;if($int ne "" && $int ne "lo0" && $int ne "gif0" && $int ne "stf0"){$allints .= $int." ";}} $allints =~ s/\ $/\n/; print $allints'

getttys.sh

#!/bin/bash

ls -1 /dev/tty.* | perl -e 'while($line=<STDIN>){($int)=$line=~/\/dev\/tty\.(.+)$/; $ints.=$int." "}$ints=~s/\ $/\n/;print $ints;'

SphereBot

Script Information

SphereBot is one of my more ongoing projects, although I haven’t had much time for IRC as much lately, so I’ve taken a break from development for an undetermined amount of time. SphereBot is an IRC bot written in Perl, designed to be completely modular. Not only is it modular, the modules can be written in any language that can read environment variables (or use the deprecated method of ARGV variables), and write to STDOUT. (Basically a CGI-like interface.) SphereBot is the successor to BoxBot. The modules can be bound to any IRC event, usually by use of regexes, but in actuality it can be done with any Perl one-liner.

The latest downloadable release of SphereBot and the original modules are available below. These are unstable, non-publicly released versions made available to specific people for testing purposes. (Please see the included readme for use & development.)

Download here.

Backslash bug – I have recently become aware of a bug affecting SphereBot’s escaping when passing data from IRC to modules, that ends up leaving a trailing ‘\’ hanging on the end of the script parameters passed to a module. So far I’ve only heard about it occurring in default Perl installs under Ubuntu, but it is likely to effect some other configurations as well.

How do you know if it effects you? Easy. Load the ‘raw’ module and as an administrator for the bot, issue this command (using your channel instead of #channel, and your prefix instead of -, obviously):

-raw PRIVMSG #channel :Test message.

If your response is similar to the one below, you are not affected.

<SphereBot> Test message.

If your response is similar to the one below, then you are affected by this bug.

<SphereBot> Test message.\

To fix it, open functions/irc_functions.pl and head towards lines 244-247 and add line 248 (shown highlighted below):

$cmd =~ s/\[\@(.*?)\:(.*?)\]/$$1{$2}/ig;
$cmd =~ s/\[\%(.*?)\]/$$1/ig;
$cmd =~ s/(.)?/\\$1/ig;
$cmd =~ s/\\ / /ig;
$cmd =~ s/\\$//ig;

Save the file & restart the bot. Problem should be sorted.
I’ll update the tarball at some point with this, but I don’t have time right now.

routersh

Script Information

routersh was a shell script designed for personal use as a login script that allows for management of iptables rules, route rules, and network interfaces, in a ‘linux box as a router’ environment. There is no support for it, but feel free to download it and customise it as you feel fit.

Script Source

#!/usr/bin/perl
use Switch;

main();

sub main {

    $ENV{'PATH'} = "/bin:/sbin:/usr/sbin:/usr/bin";

    my $hostname = `hostname --fqdn`;
    chomp($hostname);

    clearScreen();
    moveCursor(28,2);
    fancyPrint($hostname."\n\n", 32, 1, 4);

    fancyPrint("Routing\n", 36, 4);
    fancyPrint("\t[1]", 33, 1); print " Start routing\n";
    fancyPrint("\t[2]", 33, 1); print " Stop routing\n";
    fancyPrint("\t[3]", 33, 1); print " Show routes\n";
    fancyPrint("\t[4]", 33, 1); print " Edit port forwards\n";
    print "\n";
    fancyPrint("Access Point\n", 36, 4);
    fancyPrint("\t[5]", 33, 1); print " SNMP AP Config\n";
    print "\n";
    fancyPrint("Network Interfaces\n", 36, 4);
    fancyPrint("\t[6]", 33, 1); print " Show interfaces\n";
    print "\n";
    fancyPrint("Clients\n", 36, 4);
    fancyPrint("\t[7]", 33, 1); print " Show DHCP leases\n";
    fancyPrint("\t[8]", 33, 1); print " Show all active clients\n";
    print "\n";
    fancyPrint("Other\n", 36, 4);
    #fancyPrint("\t[S]", 33, 1); print " Launch shell\n";
    fancyPrint("\t[X]", 33, 1); print " Exit to shell\n";

    print "\nPlease make a selction [1-7, S, X]: ";
    $choice = ;
    chomp($choice);
    $choice = lc($choice);

    switch($choice){
        case "x" {
            exit;
        }
        case "s" {
            system('/bin/bash');
        }
        case "1" {
            $run = `/etc/rc.d/iptables start 2>&1`;
            if($run =~ /FAIL/i){
                fancyPrint("Start routing failed! Press RETURN.", 37, 41, 1);
            }else{
                fancyPrint("Routing started. Press RETURN.", 30, 42, 1);
            }
            $wait = ;
        }
        case "2" {
            $run = `/etc/rc.d/iptables stop 2>&1`;
            if($run =~ /FAIL/i){
                fancyPrint("Stop routing failed! Press RETURN.", 37, 41, 1);
            }else{
                fancyPrint("Routing stopped.  Press RETURN.", 30, 42, 1);
            }
            $wait = ;
        }
        case "3" {
            fancyPrint("Press 'q' to return. Press RETURN to continue.", 30, 42, 1);
            $wait = ;
            system("/sbin/route -e -n | /bin/less");
        }
        case "4" {
            print "What you like to add or delete a port forward? (add/del): ";
            $pfDo = ;
            chomp($pfDo);

            if(lc($pfDo) eq "add"){
                print "TCP or UDP? (tcp/udp): ";
                $proto = ;
                chomp($proto);

                if(lc($proto) eq "tcp"){ $proto = "tcp"; }
                elsif(lc($proto) eq "udp"){ $proto = "udp"; }
                else{ main(); }

                print "Destination port (WAN): ";
                $dPort = ;
                chomp($dPort);

                print "Destination IP (LAN): ";
                $dIP = ;
                chomp($dIP);

                print "New destination port (LAN): ";
                $newdPort = ;
                chomp($newdPort);

                open(FORWARDS, ">>/etc/ipForwards.conf");
                print FORWARDS $proto.",".$dPort.",".$dIP.",".$newdPort."\n";
                close(FORWARDS);

                system("/usr/sbin/iptables -A PREROUTING -t nat -p ".$proto." --dport ".$dPort." -i wan0 -j DNAT --to ".$dIP.":".$newdPort);
                system("/usr/sbin/iptables -A FORWARD -p ".$proto." -d ".$dIP." --dport ".$newdPort." -i wan0 -o lan0 -j ACCEPT");
                system("/usr/sbin/iptables -A FORWARD -p ".$proto." -s ".$dIP." --sport ".$newdPort." -i lan0 -o wan0 -j ACCEPT");

            }elsif(lc($pfDo) eq "del"){
                open(FORWARDS, "){
                    chomp($line);
                    $forwards[$count] = $line;
                    print $count.": ".$line."\n";
                    $count++;
                }
                close(FORWARDS);
                print "Number of forward to remove: ";
                $rmPort = ;
                chomp($rmPort);
                if($rmPort eq ""){ main(); }
                ($proto, $dPort, $dIP, $newdPort) = split(/,/, $forwards[$rmPort]);
                system("/usr/sbin/iptables -D PREROUTING -t nat -p ".$proto." --dport ".$dPort." -i wan0 -j DNAT --to ".$dIP.":".$newdPort);
                system("/usr/sbin/iptables -D FORWARD -p ".$proto." -d ".$dIP." --dport ".$newdPort." -i wan0 -o lan0 -j ACCEPT");
                system("/usr/sbin/iptables -D FORWARD -p ".$proto." -s ".$dIP." --sport ".$newdPort." -i lan0 -o wan0 -j ACCEPT");

                delete $forwards[$rmPort];

                open(FORWARDS, ">/etc/ipForwards.conf");
                foreach $newLine(@forwards) {
                    if($newLine ne ""){
                        print FORWARDS $newLine."\n";
                    }
                }
                close(FORWARDS);
            }else{
                main();
            }
        }
        case "5" {
            system("/usr/bin/ap-config");
        }
        case "6" {
            fancyPrint("Press 'q' to return. Press RETURN to continue.", 30, 42, 1);
            $wait = ;
            system("/sbin/ifconfig | /bin/less");
        }
        case "7" {
            my @leases;
            my $x;

            clearScreen();
            open(DHCP, "/var/state/dhcp/dhcpd.leases");
            while($line = ){
                if($line =~ /^lease (.+) \{/){
                    $ipAddr = $1;
                }
                if($line =~ /^\s+hardware ethernet (.+);/){
                    $macAddr = $1;
                }
                if($line =~ /^\s+client-hostname "(.+)";/){
                    $clientName = $1;
                }
                if($line =~ /^}/){
                    if(!$clientName){
                        $clientName = "";
                    }
                    $leases[$x][0] = $clientName;
                    $leases[$x][1] = $ipAddr;
                    $leases[$x][2] = $macAddr;
                    $clientName = "";
                    $ipAddr = "";
                    $macAddr = "";
                    $x++;
                }
            }
            close(DHCP);
            fancyPrint("Hostname", 4);
            print "\t";
            fancyPrint("Assigned IP", 4);
            print "\t\t";
            fancyPrint("MAC Address", 4);
            print "\n";
            my %shownLease;
            for($q = 0; $q <= $#leases; $q++){
                if($shownLease{$leases[$q][2]} < 1){
                    print $leases[$q][0]."\t\t";
                    print $leases[$q][1]."\t\t";
                    print $leases[$q][2]."\n";
                    $shownLease{$leases[$q][2]} = 1;
                }
            }
            fancyPrint("Press RETURN to continue.", 30, 42, 1);
            $wait = ;
        }
        case "8" {
            clearScreen();
            system("/sbin/arp -n -i lan0");
            fancyPrint("Press RETURN to continue.", 30, 42, 1);
            $wait = ;
        }
        else {
            main();
        }
    }

    main();

}
sub clearScreen {
    print "\e[2J";
    return;
}

sub moveCursor {
    my ($x, $y) = @_;

    print "\e[".$y.";".$x."H";
    return;
}

sub fancyPrint {
    my ($text) = shift(@_);

    $printStr = "\e[";
    for($i = 0; $i <= $#_; $i++){
        $printStr .= $_[$i];
        if($i < $#_){
            $printStr .= ";";
        }else{
            $printStr .= "m";
        }
    }

    $printStr .= $text."\e[0m";
    print $printStr;
    return;
}

BoxBot

BoxBot, the predecessor to SphereBot, was an extremely modular IRC bot, but the downfall lay in the fact that BoxBot’s modules were not nearly as flexible as originally planned. BoxBot’s modules were strictly Perl, and could only be bound to a few IRC events (join, part, topic, and privmsg). The PRIVMSG-bound modules had to be bound to a single specific command, which consisted of the configured command prefix ( the default was ‘::’) followed by the module name. The JOIN-, PART- and TOPIC-bound moudles could only be associated with one channel; multiple channels required multiple modules. Similarly, the PRIVMSG-bound modules could only be bound to a single command; multiple commands required multiple module files. SphereBot was conceived while trying to repair these issues with BoxBot – it was felt that the only way to fully fix these problems without using band-aid hacks was to start over from scratch. So SphereBot was born.

BoxBot is not altogether useless; however SphereBot effectively performs almost all of the functions that BoxBot was designed to. There is even a SphereBot module that allows backwards compatibility with BoxBot modules. I consider BoxBot to be deprecated. BoxBot is not available for download at the moment. In the meantime, if you wish to acquire a copy, contact me. I’ll be glad to send it to you.