#+TITLE: ~/bin files
#+AUTHOR: Mitch Tishmack
#+STARTUP: hidestars
#+STARTUP: odd
#+BABEL: :cache yes
#+PROPERTY: header-args :cache yes :padline no :mkdirp yes :comments no

~/bin files and other shenanigans

* ~/bin/cidr

A stupid script I wrote ages ago to help me be lazy with cidr
notation for stuff. Setup the wrong netmask a few times and
you too, will wish for something similar.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/cidr :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Convert input ip/cidr|netmask|hexnetmask to useable network information.
#

use strict;
use warnings;
use Socket;
use Sys::Hostname;

#
# Globalish vars
#
$ENV{PATH} = '/usr/bin:/bin:/usr/sbin:/sbin'; # Paranoia, know thy name!
my ($fqdn_regexp) = qr/([0-9,a-z,A-Z,\-,\_]+)\.([0-9,a-z,A-Z,\-,\_]+)\.(com|gov)/;

#
# converts a 1-word (4 byte) signed or unsigned integer into a dotted decimal
# ip address.
#
sub int2ip {
  my $n=int(pop);
  return(sprintf("%d.%d.%d.%d", ($n>>24)&0xff,($n>>16)&0xff,
    ($n>>8)&0xff,$n&0xff));
};

#
# Convert a host/ip/netmask/cidr/etc.... to a hash of information
# Example: host.domain.tld/24 will get the ip and calculate the netmask info
#  equally if host.domain.tld corresponds with 1.2.3.4 the following is valid
#  1.2.3.4/255.255.255.0 would obtain the same information.
#
# die()'s if anything isn't kosher.
#
# Ultra long function, probably needs to be looked at for condensing/splitting.
#
sub cidr2raw {
  my $rawinput = pop;
  my ($lhs, $rhs, $j, $uip) = (undef, undef, undef, undef);
  my ($ucidr) = 0;
  my ($network, $bits, $netmask, $broadcast, $low, $high);

  if ($rawinput =~ qr/(.*)\/(.*)/){
      $lhs = $1; $rhs = $2;
  }else{
    die "Input: $rawinput not expected.\n";
  };

  #
  # Handle ip/hostname for left hand side.
  if ($lhs =~ qr/(\d+)\.(\d+)\.(\d+)\.(\d+)/){
    foreach my $dotted (($1,$2,$3,$4)){
      if (($dotted > 255) or ($dotted < 0)){
        die "FATAL: ipv4 address entered, $lhs entered is impossible, $dotted is not between 0-255.\n";
      };
    };
    $uip = inet_ntoa(scalar gethostbyname($lhs));
    die "FATAL: Cannot determine hostname for $lhs$!\n" if (!defined($lhs));
  }elsif ($lhs =~ $fqdn_regexp){
    my $tmp = gethostbyname($lhs);
    die "FATAL: Cannot determine ip for $lhs" if (!defined($tmp));
    $uip = inet_ntoa($tmp);
  }else{
    die "FATAL: host value not fully qualified, or not an ip <$lhs>\n";
  };

  #
  # Handle the netmask/cidr for the right hand side,
  #
  # All input netmasks are converted to a cidr address for notation
  if ($rhs =~ qr/^(\d+)$/){ # /cidr
    $ucidr = $1;
    die "FATAL: Invalid CIDR <$ucidr>.$!\n" if (($ucidr > 32) or ($ucidr < 0));
  }elsif ($rhs =~ qr/(0[xX])?([0-9,a-f,A-F]{7})/){ # /0xhexnetmask
    my $trimmed = $2;
    my $insane = 0;
    foreach my $byte (split('', unpack("B32", pack("H*", $trimmed)))){
      ($byte) ? $ucidr++ : $insane++;
      die "FATAL: $rhs is not a valid hex netmask.$!\n" if ($insane and $byte);
    };
  }elsif ($rhs =~ qr/(\d+)\.(\d+)\.(\d+)\.(\d+)/){ # /255.255.255.0 form
    my @a = ($1, $2, $3, $4);
    my $insane = 0;
    foreach my $t (@a){
      die "FATAL: Netmask out of range. Input <$rhs> Invalid <$t>$!\n" if (($t < 0) or ($t > 255));
    };
    foreach my $byte (split('', unpack("B32", pack("C4", @a)))){
      ($byte) ? $ucidr++ : $insane++;
      die "FATAL: $rhs is not a valid netmask.$!\n" if ($insane and $byte);
    };
  }else{
    die "FATAL: Unknown or invalid netmask value entered. <$rhs>\n";
  };

  #
  # Network math GO! This is the meat of the function.
  my (@uip) = split(/\./, $uip);
  $network = 0;
  for ($j = 0; $j <= $#uip; $j++){
    $network += int($uip[$j])<<((3-$j)*8);
  };

  $bits = 0; $j = 0;
  for ($j = 31 - $ucidr; $j >= 0; $j--){
    $bits |= 1<<$j;
  };

  $netmask = 0xffffffff^$bits;
  $low = ($network&$netmask);
  $high = ($network&$netmask)+$bits-1;
  $broadcast = ($network&$netmask)|$bits;
  my ($guessed_hostname,undef,undef,undef,undef) = gethostbyaddr(inet_aton($uip), AF_INET);

  #
  # Throw the info back, they get a hash with zie info they may/may not need.
  # All up to the caller what they want to use.
  #
  return ("inet4" => $uip,
          "netmask" => int2ip($netmask),
          "broadcast" => int2ip($broadcast),
          "cidr" => $ucidr,
          "router" => int2ip($low+1),
          "network" => int2ip($low),
          "high" => int2ip($high),
          "hostname" => $guessed_hostname,
          );
};

#package Main; # future use

foreach my $arg (@ARGV){
  my %stuff = cidr2raw($arg);
  printf("%s/%s is %s/%s\n%-12s\t%s\n%-12s\t%s\n%-12s\t%s\n%-12s\t%s\n%-12s\t%s\n",
             $stuff{"inet4"},$stuff{"cidr"},
             $stuff{"network"},$stuff{"cidr"},
             "Netmask",$stuff{"netmask"},
             "Broadcast",$stuff{"broadcast"},
             "Network",$stuff{"network"},
             "Router",$stuff{"router"},
             "HighUsable",$stuff{"high"},
      );
};
#+END_SRC

* ~/bin/dns

Just a silly dns script that slighly mimics the old host utility
of yore. Can also do reverse lookups.

Example:
$ dns google.com
google.com is 216.58.216.206
google.com is also google.com
$ dns 216.58.216.206
ord31s21-in-f206.1e100.net is 216.58.216.206
ord31s21-in-f206.1e100.net is also ord31s21-in-f206.1e100.net

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/dns :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Stupid script to help with dns information. Solaris 9/8 lack the host utility.
# Which this (kinda) mimics, except the mx record crap
use strict;
use warnings;
use Socket;
use Sys::Hostname;

my $input = shift || hostname();
my $lookup = $input;

if ( $lookup =~ /\d+[.]\d+[.]\d+[.]\d+/smx ) {
  $lookup = ( gethostbyaddr inet_aton($lookup), AF_INET )[0];
  die "Error: Unable to reverse lookup ip $input.\n" if ( $lookup eq q{} );
}

my $ipv4 = gethostbyname $lookup;

die "Error: $lookup doesn't have any known ip addresses\n"
  if ( !defined $ipv4 );

$ipv4 = inet_ntoa($ipv4);

my ( $short_name, $aliases, $addrtype, $len, @addrs ) = gethostbyname $lookup;

foreach my $ipv4 (@addrs) {
  $ipv4 = inet_ntoa($ipv4);
  print "$lookup is $ipv4\n";
}

print "$lookup is also $short_name\n";
if ( defined $aliases and "$aliases" ne q{} ) {
  print "aliases are ($aliases)\n";
}
exit 0;
#+END_SRC

* ~/bin/ts

Stupid simple timestamp script that just takes input, and prefixes a timestamp to to output. Thats it.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/ts :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Timestamp stdin and then print to stdout and flush.
#
# Thats about it. Might add a quick and dirty option to allow you to
# specify the time output whatnot. But this is intended to be simple.
use strict;
use warnings;
use POSIX qw(strftime);
use IO::Handle;
STDOUT->autoflush(1);

while(<STDIN>){
  my $now       = time;
  my $tz        = strftime(('%z', (localtime $now)));
  $tz =~ s/(\d{2})(\d{2})/$1:$2/smx;
  my $time = strftime('%Y-%m-%dT%H:%M:%S', (localtime $now));
  print "$time$tz ".$_;
};
#+END_SRC

* ~/bin/diskhog

Old script I wrote after I had to figure out where space was used and it was mostly all in a directory with a ton of small files.

Written in anger. Not all that useful nominally.

Defaults to /tmp if you don't specify where, also defaults to the top 10 offenders/users of space.

Its not particuarly bright, or even good code. If you want ALL THE THINGS, pass -n -1 in and you will get a ton of output. Good luck with that.

Example:
$ diskhog
1.79m    /private/tmp
1.38m    /private/tmp/wifi-Ea5Y9F.log
420.57k  /private/tmp/sysp.xml
161.17k  /private/tmp/KSOutOfProcessFetcher.12572.ppfIhqX0vjaTSb8AJYobDV7Cu68=/ksfetch
161.17k  /private/tmp/KSOutOfProcessFetcher.12572.ppfIhqX0vjaTSb8AJYobDV7Cu68=
0.00k    /private/tmp/com.apple.launchd.yaVsd6J1re
0.00k    /private/tmp/cvcd
0.00k    /private/tmp/com.apple.launchd.IPS1lPqGTD
0.00k    /private/tmp/com.apple.launchd.voZH6WFol3
0.00k    /private/tmp/ct.shutdown
$ diskhog -n 4 /tmp
1.79m    /private/tmp
1.38m    /private/tmp/wifi-Ea5Y9F.log
420.57k  /private/tmp/sysp.xml
161.17k  /private/tmp/KSOutOfProcessFetcher.12572.ppfIhqX0vjaTSb8AJYobDV7Cu68=

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/diskhog :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Find out who is hogging disk space and where.
#
# Argument is the directory to start from. Only calculates size of files.
# Adds the size of files in a directory to the size of the parent directory only.
#
# Defaults to top 10 directories/files.
#
# Override with -n num to list whatever amount of large things you desire.
# Or if you want to abuse the parser, use -1 for all files/directories.
#
# Defaults to pwd for space.
#

use File::Find;
use Getopt::Long;
use Cwd;

my $debug;
my $statbug;
(exists($ENV{"DEBUG"})) ? $debug++ : undef;
my $dir = Cwd::abs_path($ARGV[-1] || Cwd::getcwd());
my %diskhogs = ();
my %inodes = ();
my ($topdev,undef,undef,undef,undef,undef,undef,undef) = lstat($dir);
local $opt_displaynum = 10;

GetOptions( 'n=i',  => \$opt_displaynum,
      );

find(\&sieve, $dir);

#
# For outputing the size of a bunch of bytes in g/m/k depending upon the size
#
sub byte_print {
  my $byte_k = 1_024;
  my $byte_m = $byte_k**2;
  my $byte_g = $byte_k**3;
  my $bytes = pop;
  my $base = $bytes;
  my $suffix = "nil";
  my $out_string = "BUG";
  if($bytes > $byte_g){
    $base = $bytes / $byte_g;
    $suffix = "g";
  }elsif($bytes > $byte_m){
    $base = $bytes / $byte_m;
    $suffix = "m";
  }else{
    $base = $bytes / $byte_k;
    $suffix = "k";
  };
  $out_string = sprintf("%.2f%s", $base, $suffix);
  return $out_string;
};

#
# Dumb function to return if an inode has already been seen.
# So we handle hard links sane(er-ish-ly) in size calculations.
# This has more truthiness(tm).
#
sub seeninode{
  my $what = pop();
  my $ret = 0;
  unless(exists($inodes{$what})){
    $inodes{$what} = 0;
    print "New inode $what added to seen inodes.\n" if $debug;
  }else{
    $inodes{$what}++;
    $ret++;
    print "Found a hardlink for $what.\n" if $debug;
  };
  return $ret;
};

sub sieve {
  my $file = $File::Find::name;
  my $filedir = $File::Find::dir;
  my @statinfo = lstat($file);
  my $dev = $statinfo[0];
  my $inode = $statinfo[1];
  my $size = $statinfo[7];
  my $blocksize = 512; # field 11 is the "preferred" block size, which appears
                       # to not match the actual blocksize of the filesystems
                       # in use. For now every hard drive uses 512bytes/block.
                       # Will revisit this when 4096byte/block hard drives arrive
  my $apparentsize = $statinfo[12] * $blocksize;

  print "$file\@$filedir \<$topdev\>\=\<$dev\>\n" if $debug;
  print "size,apparentsize,blocksize = <$statinfo[7],$apparentsize\,$blocksize\>\n" if $debug;
  #
  # Try to handle sparse files.
  #
  if ($size > $apparentsize) {
    print "Sparse file $file!\n" if $debug;
    $size = $apparentsize;
  };

  $dev = (-l $file) ? 0xdeadbeef : $dev;
  if (($file =~ m/\/proc|\/chroot|udev\/devices/) ||
      ($dev != $topdev) || seeninode($inode)){
    print "Pruned $file.\n" if $debug;
    $File::Find::prune = 1;
    next;
  };
  unless ($dev){
    # Yay, we can't l(stat) files. This version of perl is broken.
    # Snag information from ls, assume it's a file. Thanks Solaris 8, you suck.
    $statbug++;
    warn "Hit empty device statbug while stat()ing file <$file>.\n";
    my $ls = qx(ls -ld $file);
    my @raw = split(/\s+/, $ls);
    $diskhogs{"$file"} = $raw[4];
    $diskhogs{"$filedir"} += $raw[4];
  }elsif (-f){
    if ($debug){
      print "Adding $file size ", &byte_print($size), " to $filedir.\n";
      print "Adding $file size ", &byte_print($size), "\n";
    };
    $diskhogs{"$file"} = $size;
    $diskhogs{"$filedir"} += $size;
  }elsif (-d){
    print "Adding $file size ".&byte_print($size)."\n" if $debug;
    $diskhogs{"$file"} += $size;
  };
  if ($debug) {
    print "$file from $filedir has size ".&byte_print($diskhogs{"$file"})."\n";
  };
};

#
# Reverse sort the keys by size.
#
my @sorted = sort {$diskhogs{$b} <=> $diskhogs{$a}} keys %diskhogs;

splice @sorted, $opt_displaynum if @sorted > $opt_displaynum;

warn "Found one or more instances of the stat() call statbug. This is normally only present on Solaris 8 with stock perl.\n" if $statbug;

foreach (@sorted){
  printf "%-9s%s\n", &byte_print($diskhogs{$_}), $_;
};

if ($debug){
  print "DEBUG INFORMATION:\n";
  foreach (keys %diskhogs){
    printf "%-9s%s\n", &byte_print($diskhogs{$_}), $_;
  };
};
#+END_SRC

* ~/bin/ifinfo

I don't remember now why I wrote this but its just a simpler view
of interfaces on a system.

Probably some old solaris holdover thing I can nuke.

Example:
$ ifinfo
gif0@1280        127.0.0.1/8        a:b:c:d:e:f
en1@1500         10.1.10.15/24      a:b:c:d:e:f
bridge100@1500   192.168.64.1/24    a:b:c:d:e:f

Comes in slightly handy, no guarantees it parses ifconfig right tho.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/ifinfo :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Because ifconfig output is... overly verbose.
#
# Output information from ifconfig -a like so:
#   interface:mtu ipv4/cidr mac_address ipv6_addr(if applicable)
#   ipv6 is not yet in place due to a: lazy, b: can't use it yet.
#

use strict;
use Socket;
use Sys::Hostname;
$ENV{'PATH'}='/sbin:/usr/sbin:/bin:/usr/bin';

my ($fqdn_regexp) = qr/([0-9,a-z,A-Z,\-,\_]+)\.([0-9,a-z,A-Z,\-,\_]+)\.(com|gov)/;

#
# converts a 1-word (4 byte) signed or unsigned integer into a dotted decimal
# ip address.
#
sub int2ip {
  my $n=int(pop);
  return(sprintf("%d.%d.%d.%d", ($n>>24)&0xff,($n>>16)&0xff,
    ($n>>8)&0xff,$n&0xff));
};

#
# Convert a host/ip/netmask/cidr/etc.... to a hash of information
# Example: host.domain.tld/24 will get the ip and calculate the netmask info
#  equally if host.domain.tld corresponds with 1.2.3.4 the following is valid
#  1.2.3.4/255.255.255.0 would obtain the same information.
#
# die()'s if anything isn't kosher.
#
# Ultra long function, probably needs to be looked at for condensing/splitting.
#
sub cidr2raw {
  my $rawinput = pop;
  my ($lhs, $rhs, $j, $uip) = (undef, undef, undef, undef);
  my ($ucidr) = 0;
  my ($network, $bits, $netmask, $broadcast, $low, $high);

  if ($rawinput =~ qr/(.*)\/(.*)/){
      $lhs = $1; $rhs = $2;
  }else{
    die "Input: $rawinput not expected.\n";
  };

  #
  # Handle ip/hostname for left hand side.
  if ($lhs =~ qr/(\d+)\.(\d+)\.(\d+)\.(\d+)/){
    foreach my $dotted (($1,$2,$3,$4)){
      if (($dotted > 255) or ($dotted < 0)){
        die "FATAL: ipv4 address entered, $lhs entered is impossible, $dotted is not between 0-255.\n";
      };
    };
    $uip = "$1.$2.$3.$4";
  };
  #
  # Handle the netmask/cidr for the right hand side,
  #
  # All input netmasks are converted to a cidr address for notation
  if ($rhs =~ qr/^(\d+)$/){ # /cidr
    $ucidr = $1;
    die "FATAL: Invalid CIDR <$ucidr>.$!\n" if (($ucidr > 32) or ($ucidr < 0));
  }elsif ($rhs =~ qr/(0[xX])?([0-9,a-f,A-F]{7})/){ # /0xhexnetmask
    my $trimmed = $2;
    my $insane = 0;
    foreach my $byte (split('', unpack("B32", pack("H*", $trimmed)))){
      ($byte) ? $ucidr++ : $insane++;
      die "FATAL: $rhs is not a valid hex netmask.$!\n" if ($insane and $byte);
    };
  }elsif ($rhs =~ qr/(\d+)\.(\d+)\.(\d+)\.(\d+)/){ # /255.255.255.0 form
    my @a = ($1, $2, $3, $4);
    my $insane = 0;
    foreach my $t (@a){
      die "FATAL: Netmask out of range. Input <$rhs> Invalid <$t>$!\n" if (($t < 0) or ($t > 255));
    };
    foreach my $byte (split('', unpack("B32", pack("C4", @a)))){
      ($byte) ? $ucidr++ : $insane++;
      die "FATAL: $rhs is not a valid netmask.$!\n" if ($insane and $byte);
    };
  }else{
    die "FATAL: Unknown or invalid netmask value entered. <$rhs>\n";
  };

  #
  # Network math GO! This is the meat of the function.
  my (@uip) = split(/\./, $uip);
  $network = 0;
  for ($j = 0; $j <= $#uip; $j++){
    $network += int($uip[$j])<<((3-$j)*8);
  };

  $bits = 0; $j = 0;
  for ($j = 31 - $ucidr; $j >= 0; $j--){
    $bits |= 1<<$j;
  };

  $netmask = 0xffffffff^$bits;
  $low = ($network&$netmask);
  $high = ($network&$netmask)+$bits-1;
  $broadcast = ($network&$netmask)|$bits;

  #
  # Throw the info back, they get a hash with zie info they may/may not need.
  # All up to the caller what they want to use.
  #
  return ("inet4" => $uip,
          "netmask" => int2ip($netmask),
          "broadcast" => int2ip($broadcast),
          "cidr" => $ucidr,
          "router" => int2ip($low+1),
          "network" => int2ip($low),
          "high" => int2ip($high),
          );
};

my @ifout;
if ($ENV{'TESTING'} ne '') {
    while(<>){
        chomp($_);
        last if ($_ eq '');
        push(@ifout, $_);
#        sleep 1;
#        print STDERR $_ . "\n";
    }
}else{
    open IFCONFIG, "ifconfig -a |";
    @ifout = <IFCONFIG>;
    close IFCONFIG;
}

# This seems wrong but it makes parsing easier due to solaris
# non root ifconfig not displaying the mac address. Reverse the output.
#
@ifout = reverse(@ifout);

my @output = ();

my ($ifname, $ifether, $ifmtu, $ifipv4, $ifnetmask, $ifipv6) = (undef,undef,undef,undef,undef,undef);
sub printiface{
  # assume a /32 if we don't know it
  unless (defined($ifnetmask)) {
    warn "$ifname has indeterminant netmask assuming /32\n";
    $ifnetmask = '32';
  }

  unless (defined($ifnetmask)) {
    $ifether = 'unknown';
  }

  unless ($ifname =~ m/lo.*/){
    my %netinfo = cidr2raw("$ifipv4\/$ifnetmask");
    $ifnetmask = $netinfo{"cidr"};
    $ifether = lc($ifether);
    my $line = sprintf "%-16s %-18s %-17s\n", "$ifname\@$ifmtu", "$ifipv4\/$ifnetmask", $ifether;
    push @output, $line;
  }

  # reset vars
  ($ifname, $ifether, $ifmtu, $ifipv4, $ifnetmask, $ifipv6) = (undef,undef,undef,undef,undef,undef);
};

foreach my $line (@ifout) {
  if ($line =~ /inet\s+(\d+[.]\d+[.]\d+[.]\d+)\s+/){
    $ifipv4 = $1;
  }
  if ($line =~ m/ether\s([:,0-9,a-f,A-F]{11,})/){
    $ifether =$1;
  }
  if ($line =~ m/^([\w,\:\d+]+)\s+.*HWaddr\s([:,0-9,a-f,A-F]{11,})/){
    $ifname = $1;
    $ifether = $2;
  }
  if ($line =~ m/^(.*)\:\s+.*mtu\s(\d+)/){
    $ifname = $1;
    $ifmtu = $2;
  }
  if ($line =~ m/MTU[:](\d+)/){
    $ifmtu = $1;
  }
  if ($line =~ m/inet\saddr\:(\d+[.]\d+[.]\d+[.]\d+)/){
    $ifipv4 = $1;
  }
  if ($line =~ m/netmask\s+(0[xX])?([a-f,A-F,0-9]{8})/){
    $ifnetmask = $2;
  }
  if ($line =~ m/Mask[:](\d+\.\d+\.\d+\.\d+)/){
    $ifnetmask = $1;
  }
  if ($line =~ m/netmask\s+(\d+[.]\d+[.]\d+[.]\d+)/){
    $ifnetmask = $1;
  }
  if ($line =~ m/netmask\s+0\s+broadcast/){
    $ifnetmask = '0';
  }

  print ":$ifether:$ifname:$ifmtu:$ifipv4:$ifnetmask:$ifipv6:\n" if ($ENV{'DEBUG'} ne '');
  printiface() if ($ifname and $ifmtu and $ifipv4 );
};

if (scalar(@output) < 1){
  warn "No interfaces? Scripts busted yo.\n";
}else{
  foreach my $line (reverse(@output)){
    print $line;
  }
}
#+END_SRC
* ~/bin/iso8601

Mostly because I use iso8601 timestamps and its nice to use them
generally without depending on gnu date.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/iso8601 :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#-*-mode: Perl; coding: utf-8;-*-
use strict;
use warnings;
use POSIX qw(strftime);
use Getopt::Long;

my $short = 0;
GetOptions('short' => \$short,
	   's' => \$short
	  );

my $now       = time;
if ($short) {
  print strftime('%Y%m%dT%H%M%SZ', (gmtime $now)) . "\n";
} else {
  print strftime('%Y-%m-%dT%H:%M:%SZ', (gmtime $now)) . "\n";
}
exit 0;
#+END_SRC

* ~/bin/whoson

Basically getent passwd $username/$uid to show who is on a system.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/whoson :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Because i'm lazy and sick of typing in getent passwd $someusername/uid
#

my %who_cmds = ("solaris", "/bin/who -q",
                "linux", "/usr/bin/who -q",
                "darwin", "/usr/bin/who -q",
               );

my $who_cmd = $who_cmds{$^O};

local %users = ();

foreach my $l (qx/$who_cmd/){
  next if($l =~ m/^\#.*/);
  foreach my $user (split(/\s+/,$l)){
    unless(exists($users{$user})){
      $users{$user} = 0;
    }else{
      $users{$user}++;
    };
  };
};

foreach my $user (keys %users){
  my $gecos = ( getpwnam($user) )[6];
  my $count = $users{$user} + 1;
  my $output = "$user\, ".((defined($gecos)) ? "$gecos, " : '')."is logged in on $count tty".(($count>1) ? "\'s" : '')."\n";
  print $output;
};
#+END_SRC

* ~/bin/gecos

Silly wrapper perl script that makes it easier to get at the gecos string for a $user/$uid.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/gecos :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Dumb wrapper to get the gecos information from a uid/username.

foreach my $input (@ARGV){
  my $gecos = undef;
  my $uid = undef;
  my $name = undef;
  if ( $input =~ m/^\d+$/ ) {
    ( $name,$uid,$gecos ) = ( getpwuid($input) )[0,2,6];
  } else {
    ( $name,$uid,$gecos ) = ( getpwnam($input) )[0,2,6];
  }
  print "$name is '$gecos' uid '$uid'\n" if $gecos;
}
#+END_SRC

* ~/bin/hatimerun

Stupid perl script to mimic hatimerun for systems that don't have it.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/hatimerun :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# hatimerun in perl, sorta
#
use Getopt::Long;

my $opt_exitcode = 99;
my $opt_killcode = 9;
my $opt_timeout = 60;

GetOptions( 'e=i' => \$opt_exitcode,
            'k=i' => \$opt_killcode,
            't=i' => \$opt_timeout,
            'h' => \&opt_help,
            'help' => \&opt_help,
);

sub opt_help{
  my $message = <<__END__;
UX: ERROR: invalid syntax
usage: [-e return code][-k kill signal][-t seconds to wait]
       [-h][--help]

  Options
      --help, -h     Prints this help text.
      -e             Exit code to return on timeout.
                     NOTE: 99 by default.
      -k             Signal number to send via kill.
                     NOTE: 9 by default.
      -t             Timeout in seconds before alarming.
                     NOTE: 60 by default.

__END__
  print $message;
  exit 1;
};

my $pid;

local $SIG{ALRM} = sub { kill $opt_killcode, $pid or die "Kill failed: $!";
                         die "Timeout!\n"};

eval{
  my $x = defined($pid = fork());

  unless ($pid){
    print qx(@ARGV);
    die "Exec of ", join(' ', @ARGV), " failed at $!\n";
  };

  alarm $opt_timeout;
  waitpid $pid => 0;
  alarm 0;
  exit 0;
};

if ($@){
  die "Nothing to do!\n" unless $@ eq "Timeout!\n";
  exit $opt_exitcode;
}else{
  exit 0;
};
#+END_SRC

* ~/bin/ptree.pl

Silly perl based ptree alike implementation. Mad old code that should be avoided at all costs but it works and I'm not fixing it unless I need to.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/ptree.pl :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# ptree for linux/darwin/solaris. I got sick of ps and pstree on linux.
# ptree works on solaris fine, but doesn't exist for darwin/linux/etc...
#
# TODO: Allow passing a regexp instead of a pid and passing multiple pids.
#

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

(exists($ENV{"DEBUG"})) ? $debug = 1 : undef;
($debug) ? local $| = 1 : undef; # disable buffering for STDERR and STDOUT

sub debug_print {
  ($debug) && warn pop;
};

local @cmd = ('/bin/ps');
local $init = 0;
local $start = 1;

if ($^O eq "linux"){
  push(@cmd, 'ajxSw');
  $start = 0;
}elsif ($^O =~ m/darwin|freebsd/){
  push(@cmd, 'Ajwww');
}elsif ($^O eq "solaris"){
  @cmd = ('/usr/ucb/ps');
  if ((-x "/bin/zonename") && !(qx(zonename) eq "global\n")){
    $init = qx(pgrep zsched);
    chomp($init);
    $start = $init;
  };
  push(@cmd, 'laxwww');
}else{
  die "$^O isn't a known os to this script\n";
};

local @ps = qx(@cmd);
($?) ? die $cmd[0]." posix return code $?\n" : undef;

local %proc;
local @trail;

(defined($ARGV[0])) ? $start = $ARGV[0] : undef;

debug_print("Dump of raw line array data:\n");

foreach my $x (@ps){
  my $cmd_index = 9;
  my $ppid = -1;
  my $pid = -1;
  next if ($x =~ m/.*PID.*/);
  my @line = split(m/\s+/,$x);
  splice(@line, 0, 1) unless ($line[0] =~ m/\d+/);
  splice(@line, 0, 1) if ("$line[0]" eq "");

  if ($^O eq "linux"){
    ($ppid,$pid) = @line;
    $cmd_index = 9;
  }elsif ($^O =~ m/darwin|freebsd/){
    ($pid,$ppid) = @line;
    $cmd_index = 8;
  }elsif ($^O eq "solaris"){
    (undef, undef, $pid,$ppid) = @line;
    for($x=$cmd_index; $x < 14; $x++){
      $cmd_index = ($line[$x] =~ m/\d+\:\d+/) ? ($x + 1) : $cmd_index;
    };
  };

  my $command = join(' ', @line[$cmd_index..$#line++]);
  (!defined $proc{$pid}) ? $proc{$pid}->{"children"} = [ ] : undef;
  (!defined $proc{$ppid}) ? $proc{$ppid}->{"children"} = [ ] : undef;
  $proc{$pid}->{"pid"} = $pid;
  $proc{$pid}->{"command"} = $command;
  $proc{$pid}->{"ppid"} = $ppid;
  push(@{$proc{$ppid}->{"children"}},$pid);
  debug_print(join(',', @line[0..($#line-1)])."\n");
};

if ($debug){
  debug_print("Done reading ps output\nDump of Hash\n");
  foreach my $key (sort({$a <=> $b} (keys %proc))){
    $ppid = $proc{$key}->{"ppid"};
    $command = $proc{$key}->{"command"};
    $children = join(',', @{$proc{$key}->{"children"}});
    debug_print("PID<$key> PPID<$ppid> Children<$children> Command<$command>\n");
  };
};

sub intrail{
  my $crumb = pop;
  my $ret = 0;
  map {$ret++ if ($crumb == $_)} @trail;
  return $ret;
};

sub addchildren{
  my $start_node = pop;
  foreach my $child (@{$proc{$start_node}->{"children"}}){
    next if (!defined($child) || ($start_node == $child));
    debug_print("Start ($start_node) Add child $child.\n");
    push(@trail, $child);
    addchildren($child);
  };
};

sub addparents{
  my $start_node = pop;
  my $parent = $proc{$start_node}->{"ppid"};
  return unless (defined($start_node));
  return if (($parent == $start_node) || !(defined($parent))); # At the top of the tree, or in a zone
  debug_print("Start ($start_node) Add parent $parent.\n");
  push(@trail, $parent);
  addparents($parent) if ($parent != $init);
};

sub printnode{
  my $start_node = pop;
  my $indent = pop;
  if (intrail($start_node)){
    my $pid = $proc{$start_node}->{"pid"};
    my $ppid = $proc{$start_node}->{"ppid"};
    my $cmdline = $proc{$start_node}->{"command"};
    my $indentation = '  'x($indent);
    if ($pid == $init){
      my $s = $^O." kernel";
      if ($cmdline ne ''){
        $s = $s." <$cmdline>";
      };
      $cmdline = $s;
    };
    printf("%s%d   %s\n", $indentation, $pid, $cmdline);
    foreach my $child (@{$proc{$start_node}->{"children"}}){
      next if ($pid == $child);
      printnode($indent+1,$child);
    };
  };
};

my $valid = 0;
foreach my $j (keys %proc){ ($j == $start) ? $valid++ : undef; };

debug_print("Starting from <$start>, validity is<$valid>\n");

if ($valid){
  if (!$start){
    @trail = keys %proc;
    push(@trail, $start); push(@trail, 1);
    debug_print("Done with adding $start to trail.\n");
  }else{
    push(@trail, $start);
    debug_print("Adding children from $start.\n");
    addchildren($start);
    debug_print("Adding parents from $start.\n");
    addparents($start);
  };

  @trail = sort(@trail);

  debug_print("Trail is: ".join(',', @trail)."\nStarting at pid $start\ninit pid $init\n");
  print "PID COMMAND\n";
  my $startindent = 0;
  (intrail($startindent)) ? $startindent = -1 : undef;
  printnode($startindent,$init);
}else{
  die "pid $start doesn't exist.\n";
};

exit 0;
#+END_SRC

* ~/bin/portchk

Just find out if a port responds to anything tcp related or not.

#+BEGIN_SRC perl :mkdirp yes :tangle tmp/bin/portchk :results replace :tangle-mode (identity #o755)
#!/usr/bin/env perl
#
# Dumb wrapper to get the gecos information from a uid/username.

foreach my $input (@ARGV){
  my $gecos = undef;
  my $uid = undef;
  my $name = undef;
  if ( $input =~ m/^\d+$/ ) {
    ( $name,$uid,$gecos ) = ( getpwuid($input) )[0,2,6];
  } else {
    ( $name,$uid,$gecos ) = ( getpwnam($input) )[0,2,6];
  }
  print "$name is '$gecos' uid '$uid'\n" if $gecos;
}
#+END_SRC

* ~/bin/notify

OSX only really, just fires off a notification when its ran.

Example:
notify "some command" "not ok"

First param is the message, second title of the notification.

#+BEGIN_SRC sh :mkdirp yes :tangle (when (eq osx-p t) "tmp/bin/notify") :results replace :tangle-mode (identity #o755)
#!/bin/sh
message=${1:="no message"}
title=''
if [ "${2}" != "" ]; then
  message="${2}"
  title="${1}"
fi
notification="display notification \"${message}\""
[ "${title}" != "" ] && notification="${notification} with title \"${title}\""

osascript -e "${notification}"
#+END_SRC

* ~/bin/today

Stupid ruby script I wrote to highlight the week/day in a calendar.

#+BEGIN_SRC ruby :mkdirp yes :tangle tmp/bin/today :results replace :tangle-mode (identity #o755)
#!/usr/bin/env ruby
cal, today, week_color, day_color, reset = %x(cal).split(%r(\n)), Time.now.day, %x(tput sgr0;tput setab 4;tput setaf 7), %x(tput sgr0; tput setab 0;tput setaf 7;tput bold), %x(tput sgr0)
done=false
cal.each do |line|
  if done then
    puts line
    next
  end
  if(line =~ /^(.*\s+?)#{today}(\s+?.*)$/ or
     line =~ /^(.*\s+?)#{today}$/ or
     line =~ /^()#{today}(\s+?.*)$/ or
     line =~ /^#{today}$/ ) then
    puts "#{week_color}#{$1}#{day_color}#{today}#{week_color}#{$2}#{reset}"
    done=true
  else
    puts line
  end
end
#+END_SRC