prototyp: processes – old version with /proc parsing
authorFrantišek Kučera <franta-hg@frantovo.cz>
Mon, 01 Sep 2014 22:47:19 +0200
changeset 119ff9cd2d677a
parent 10 88bf2cb5e757
child 12 c6688467d03c
prototyp: processes – old version with /proc parsing
prototyp/prototyp.sql
     1.1 --- a/prototyp/prototyp.sql	Mon Sep 01 21:38:26 2014 +0200
     1.2 +++ b/prototyp/prototyp.sql	Mon Sep 01 22:47:19 2014 +0200
     1.3 @@ -202,8 +202,7 @@
     1.4  
     1.5  CREATE TYPE unix_sql_api_processes AS (
     1.6  	id INTEGER,
     1.7 -	uid INTEGER,
     1.8 -	owner VARCHAR,
     1.9 +	owner INTEGER,
    1.10  	command VARCHAR,
    1.11  	arguments VARCHAR[],
    1.12  	working_dir VARCHAR
    1.13 @@ -214,16 +213,34 @@
    1.14  	use strict;
    1.15  	use warnings;
    1.16  	
    1.17 -	use encoding "UTF-8";
    1.18 +	# aptitude install libproc-processtable-perl
    1.19 +	# TODO: use Proc::ProcessTable::Process;
    1.20  	
    1.21 -		return_next({
    1.22 -			id => 123,
    1.23 -			uid => 456,
    1.24 -			owner => "nikdo",
    1.25 -			command => "/bin/omg",
    1.26 -			arguments => ["a", "b"],
    1.27 -			working_dir => "/tmp"
    1.28 -		});
    1.29 +	my $dir = "/proc";
    1.30 +	
    1.31 +	opendir(DIR, $dir) or die $!;
    1.32 +	while (readdir(DIR)) {
    1.33 +		if (/\d+/) {
    1.34 +			my $pid = $_;
    1.35 +			my @process_dir_stat = stat("$dir/$pid") or next;
    1.36 +			my $uid = $process_dir_stat[4];
    1.37 +			
    1.38 +			open(CMDLINE, "<$dir/$pid/cmdline");
    1.39 +			binmode CMDLINE;
    1.40 +			my $cmdline;
    1.41 +			read(CMDLINE, $cmdline, 65536);
    1.42 +			
    1.43 +			my @cmdline_parts = split(0x00, $cmdline);
    1.44 +			
    1.45 +			return_next({
    1.46 +				id => $pid,
    1.47 +				owner => $uid,
    1.48 +				command => readlink("$dir/$pid/exe"),
    1.49 +				arguments => ["xxx"],
    1.50 +				working_dir => readlink("$dir/$pid/cwd")
    1.51 +			});
    1.52 +		}
    1.53 +	}
    1.54  	
    1.55  	return undef;
    1.56  $$ LANGUAGE plperlu;