#!/usr/local/bin/perl

# little script i wrote to automate this, values can be changed and even added, just stick to same structure
# and you wont have a problem ;>
#
# requires IO::CaptureOutput module, to install: perl -MCPAN -e 'install IO::CaptureOutput'
#
# craftsmanship by acidrein. (ar) 20/03/2008.

use strict;
use warnings;
use vars qw(%netctl %vmemctl %store);
use IO::CaptureOutput qw(capture capture_exec);

our $uid = getlogin();
our $vuid = "root";
our $sysctl = "/sbin/sysctl";

%netctl = (
	'net.ipv4.tcp_rmem' => '8192 1677722 16777216',
	'net.ipv4.tcp_wmem' => '4096 1468006 14680064',
	'net.ipv4.tcp_mem' => '94368 125824 188736',
	'net.core.rmem_default' => '2097152',
	'net.core.wmem_default' => '2097152',
	'net.core.rmem_max' => '16777216',
	'net.core.wmem_max' => '14680064',
	'net.core.optmem_max' => '2097152',
	'net.core.netdev_max_backlog' => '4500',
	'net.core.somaxconn' => '512',
	'net.ipv4.tcp_sack' => '1',
	'net.ipv4.tcp_fack' => '1',
	'net.ipv4.tcp_ecn' => '1',
	'net.ipv4.tcp_no_metrics_save' => '1',
	'net.ipv4.tcp_max_syn_backlog' => '1024',
	'net.ipv4.tcp_fin_timeout' => '25',
	'net.ipv4.tcp_keepalive_time' => '1800',
	'net.ipv4.tcp_max_tw_buckets' => '256000',
	'net.ipv4.tcp_timestamps' => '1',
	'net.ipv4.tcp_workaround_signed_windows' => '0',
	'net.ipv4.tcp_syncookies' => '1',
	'net.ipv4.conf.all.rp_filter' => '1',
	'net.ipv4.conf.default.rp_filter' => '1',
	'net.ipv4.conf.default.arp_filter' => '1',
	'net.ipv4.conf.all.arp_filter' => '1',
);

%vmemctl = (
	'vm.min_free_kbytes' => '65536',
	'vm.dirty_background_ratio' => '4',
	'vm.dirty_ratio' => '67',
	'vm.dirty_writeback_centisecs' => '650',
	'vm.dirty_expire_centisecs' => '5000',
	'vm.overcommit_memory' => '2',
);	

%store = ();

sub dec2bin {
	my $str = unpack("B32", pack("N", shift));

	# remove leading zeros
	$str =~ s/^0+(?=\d)//;
	return $str;
}

sub bin2dec {
	return unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}

sub do_sysctl($@) {
	my ($skey, $sval) = @_;

	my ($tmpout, $tmperr, $i, $av, $tmplen, $tmpslen, $tmpbuf);
	my (@ma, @sa, @tmpb, @tmpe, @abn) = ();

	# do read from sysctl bit to test current values
	($tmpout, $tmperr) = capture_exec("$sysctl $skey");

	# check error status and search for unknown in stderr
	if ($? != 0) {
		if ($tmperr =~ /unknown/) {
			return 127;
		}
		return $?;
	}

	# find index of where '=' is in stdout string, incr by +1 which is first char after
	$tmplen = length($tmpout);
	$tmpslen = index($tmpout,'=') + 1;

	# use index value to get new start point of tmpout
	$tmpout = substr($tmpout, $tmpslen, $tmplen - $tmpslen);
	
	# clean up excess whitepsaces by matching word chars
	@ma = $tmpout =~ m/\b([\w]{1,})\b/g;

	if (scalar(@ma) == 0) {
		return 127;
	}
	$av = scalar(@ma);

	if ($av > 1) {
		@sa = split(' ', $sval);
		# bn is root 2, @abn is array holding binary values
		my ($bi,$zbn) = (0,0000);
		my $bn = 2;

		for ( $bi = 0; $bi < $av; $bi++ ) {
			# take power of 2 and convert to bin for true false compare
			my $tdn = $bn << ($bi + 1);
			my $tbn = dec2bin($tdn);

			if ($sa[$bi] == $ma[$bi]) {
				push(@abn, $tbn);  		
			}
			else {
				push(@abn, dec2bin($zbn));
			}
		}
		
		$i = 0;
		for ( $bi = 0; $bi < $av; $bi++ ) {
			if (bin2dec($abn[$bi]) != 0) {
				$i++;	
			}
		}

		if ($av == $i) {
			return 1;
		}
		
		#printf("%s -w %s=\"%s\"\n", $sysctl, $skey, $sval);
		system("$sysctl -w $skey=$sval");
		if ($? >= 0) {
			return $?;
		}
	}
	else {
		# join our matches with single whitespace now
		$i = join(' ', @ma); 

		if ($sval != $i) {
			#printf("%s -w %s=%s\n", $sysctl, $skey, $sval);
			system("$sysctl -w $skey=$sval");
			if ($? >= 0) {
				return $?;
			}
		}
		
	}
	return 1;
} 

sub chkexit($@$) {
	my ($key,$val,$exit) = @_;

	# check return values, 0 = success, 1 = same value, 127 = value non-existant
	if ($exit == 0) {
		printf("%s has been changed to %s.\n", $key, $val);
	}
	elsif ($exit == 1) {
		#printf("%s is same as current value, skipping.\n", $key);
	}
	elsif ($exit == 127) {
		printf("%s no existo on your systemo, adios.\n", $key);
	}
	else {
		printf("unknown exit code from sysctl, check man. exit code: '%d'\n", $exit);
	}
}

sub main {
	my $vret;
	
	# check uid current
	if ($uid !~ m/$vuid/) {
		printf("You must be logged in as %s to change these settings, %s is not valid\n", $vuid, $uid);
		return 0;
	}

	# create local hash array with pointers to global hash arrays
	my %ht = ( hn => \%netctl,
		   hv => \%vmemctl,
	);

	# we cant pass the physical hash to the for loop so we create a pointer to it
	my $hptr = \%ht;
	
	# loop through all the keys of the hashes yay
	foreach	my $k (keys %{$hptr}) {
		my $kv = $hptr->{$k};
		foreach my $hkey (sort keys %{$kv}) {
			my $hval = $kv->{$hkey};

			# pass key and value to function to test and write sysctl stuff
			$vret = do_sysctl($hkey, ${hval});

			chkexit($hkey,$hval,$vret);
		}
	}

	return 0;
}

main();