~/bin files and other shenanigans
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.
#!/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"},
);
};
Just a silly dns script that slighly mimics the old host utility of yore. Can also do reverse lookups.
Example: $ s google.com google.com is 216.58.216.206 google.com is also google.com $ s 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
#!/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 ( !(defined $lookup) or $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;
Stupid simple timestamp script that just takes input, and prefixes a timestamp to to output. Thats it.
#!/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 ".$_;
};
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: $ skhog 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 $ skhog -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=
#!/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{$_}), $_;
};
};
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:
$ info
gif0@1280 127.0.0.1/8 a🅱️c
e:f
en1@1500 10.1.10.15/24 a🅱️c
e:f
bridge100@1500 192.168.64.1/24 a🅱️c
e:f
Comes in slightly handy, no guarantees it parses ifconfig right tho.
#!/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;
}
}
Mostly because I use iso8601 timestamps and its nice to use them generally without depending on gnu date.
#!/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;
Basically getent passwd $urname/$u to show who is on a system.
#!/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;
};
Silly wrapper perl script that makes it easier to get at the gecos string for a $ur/$u.
#!/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;
}
Stupid perl script to mimic hatimerun for systems that don't have it.
#!/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;
};
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.
#!/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;
Just find out if a port responds to anything tcp related or not.
#!/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;
}
More for nix on macos, but just merges NixOS/nipkgs origin/master to the current branch in a tmux window and watches it.
#!/usr/bin/env sh
#-*-mode: Shell-script; coding: utf-8;-*-
# File: tmux-nix.sh
# Copyright: 2017 Mitch Tishmack
# Description: instantiate tmux nix session
export script=$(basename "$0")
export dir=$(cd "$(dirname "$0")"; pwd)
export iam=${dir}/${script}
set -e
session=nix
cd ~/src/github.com/NixOS/nixpkgs
if ! tmux has-session -t ${session}; then
tmux new-session -d -s ${session} -n nix
tmux send-keys -t ${session}:0 'sleep 30
while true; do
blah=$(nix-env -iA --dry-run stdboth nixpkgs.default | grep /nix); echo "${blah}" | head -n $(echo "$LINES - 2" | bc); echo "${blah}" | grep -c /nix | ts
echo "${blah}" | grep /nix > /dev/null 2>&1
if [ $? -eq 0 ]; then
sleep 60
clear
else
exit 0
fi
done
' C-m
tmux split-window -v -t ${session}:0
tmux send-keys -t ${session}:0.1 'git fetch --all && git merge origin/master &&
time nix-env -iA nixpkgs.default && nix-env -u --leq && exit 0
' C-m
tmux select-window -t ${session}:0
fi
tmux attach -t ${session}
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.
#!/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}"
Stupid ruby script I wrote to highlight the week/day in a calendar. I don't remember why I wrote it.
TODO: why the hell is :mkdirp yes needed here but nowhere else?
#!/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