-- SQL-UNIX-API (prototype)

-- Copyright © 2014 František Kučera (frantovo.cz)

-- 

-- This program is free software: you can redistribute it and/or modify

-- it under the terms of the GNU General Public License as published by

-- the Free Software Foundation, either version 3 of the License, or

-- (at your option) any later version.

-- 

-- This program is distributed in the hope that it will be useful,

-- but WITHOUT ANY WARRANTY; without even the implied warranty of

-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

-- GNU General Public License for more details.

-- 

-- You should have received a copy of the GNU General Public License

-- along with this program. If not, see <http://www.gnu.org/licenses/>.

-- CREATE SCHEMA unix_sql_api;

SET search_path TO unix_sql_api;

-- fstab: --------------------------------------------------------------------

DROP VIEW IF EXISTS fstab;

DROP FUNCTION IF EXISTS fstab();

DROP TYPE IF EXISTS unix_sql_api_fstab;

CREATE TYPE unix_sql_api_fstab AS (

	device VARCHAR,

	device_type VARCHAR,

	device_value VARCHAR,

	mount_point VARCHAR,

	type VARCHAR,

	types VARCHAR[],

	options VARCHAR[],

	dump INTEGER,

	pass INTEGER

);

CREATE OR REPLACE FUNCTION fstab()

RETURNS SETOF unix_sql_api_fstab AS $$

	use strict;

	use warnings;

	open(FSTAB, "<", "/etc/fstab") or die $!;

	while (<FSTAB>) {

		if (/^([^\s#]+)\s+([^\s]+)\s+([^\s]+)\s+([^\s]+)\s+(\d+)\s+(\d+)\s*$/) {

			my $device_spec_type;

			my $device_spec_value;

			{

				if ($1 =~ /([^=]+)=(.*)/) {

					($device_spec_type, $device_spec_value) = ($1, $2);

				}

			}

			return_next({

				device => $1,

				device_type => $device_spec_type,

				device_value => $device_spec_value,

				mount_point => $2,

				type => $3,

				types => [split(",", $3)],

				options => [split(",", $4)],

				dump => $5,

				pass => $6

			});

		}

	}

	return undef;

$$ LANGUAGE plperlu;

CREATE OR REPLACE VIEW fstab AS

	SELECT * FROM fstab()

;

-- user groups: --------------------------------------------------------------

DROP VIEW IF EXISTS users_groups;

DROP VIEW IF EXISTS groups;

DROP FUNCTION IF EXISTS groups();

DROP TYPE IF EXISTS unix_sql_api_groups;

CREATE TYPE unix_sql_api_groups AS (

	id INTEGER,

	name VARCHAR,

	members VARCHAR[]

);

CREATE OR REPLACE FUNCTION groups()

RETURNS SETOF unix_sql_api_groups STABLE AS $$

	use strict;

	use warnings;

	use User::grent;

	setgrent();

	while (my $group = getgrent()) {

		return_next({

			id => $group->gid,

			name => $group->name,

			members => [@{$group->members}]

		});

	}

	endgrent();

	return undef;

$$ LANGUAGE plperlu;

CREATE OR REPLACE VIEW groups AS

	SELECT * FROM groups()

;

COMMENT ON COLUMN groups.members IS 'does not contain users who have this group as primary one – see view: users_groups';

-- users: --------------------------------------------------------------------

DROP VIEW IF EXISTS users;

DROP FUNCTION IF EXISTS users();

DROP TYPE IF EXISTS unix_sql_api_users;

CREATE TYPE unix_sql_api_users AS (

	id INTEGER,

	gid INTEGER,

	name VARCHAR,

	-- comment VARCHAR,

	gecos VARCHAR[],

	home VARCHAR,

	shell VARCHAR

	-- expire VARCHAR

);

CREATE OR REPLACE FUNCTION users()

RETURNS SETOF unix_sql_api_users STABLE AS $$

	use strict;

	use warnings;

	use encoding "UTF-8";

	use User::pwent;

	setpwent();

	while (my $user = getpwent()) {

		return_next({

			id => $user->uid,

			gid => $user->gid,

			name => $user->name,

			# comment => $user->comment,

			gecos => [split(",", $user->gecos)],

			home => $user->dir,

			shell => $user->shell,

			# expire => $user->expire

		});

	}

	endpwent();

	return undef;

$$ LANGUAGE plperlu;

CREATE OR REPLACE VIEW users AS

	SELECT * FROM users()

;

-- users_groups: -------------------------------------------------------------

CREATE OR REPLACE VIEW users_groups AS

	SELECT

		u1.id AS uid,

		u1.gid AS gid,

		u1.name AS user,

		g1.name AS group,

		true AS initial

	FROM users AS u1

	JOIN groups AS g1 ON (u1.gid = g1.id)

	UNION

	SELECT

		u2.id AS uid,

		g2.*,

		false AS initial

	FROM

		(SELECT

			id AS gid,

			unnest(members) AS user,

			name AS group

		FROM groups) AS g2

	JOIN users AS u2 ON (u2.name = g2.user)

;

COMMENT ON COLUMN users_groups.initial IS 'whether this group is the „initial login group“ of given user (the primary group)';

-- processes: ----------------------------------------------------------------

DROP VIEW IF EXISTS processes;

DROP FUNCTION IF EXISTS processes();

DROP TYPE IF EXISTS unix_sql_api_processes;

CREATE TYPE unix_sql_api_processes AS (

	id INTEGER,

	owner INTEGER,

	command VARCHAR,

	arguments VARCHAR[],

	working_dir VARCHAR

);

CREATE OR REPLACE FUNCTION processes()

RETURNS SETOF unix_sql_api_processes STABLE AS $$

	use strict;

	use warnings;

	# There is a library…

	# aptitude install libproc-processtable-perl

	# use Proc::ProcessTable::Process;

	# But there can be found:

	# /* replace all '\0' with spaces (except for the last one */

	# for (cur = cmndline_text; cur < cmndline_text + cmndline_off - 1; cur++) {

	# if (*cur == '\0')

	# 	*cur = ' ';

	# }

	# which wipes boundaries between arguments (that can also contain spaces)

	# So wait until the patch https://rt.cpan.org/Public/Bug/Display.html?id=52442 will be integrated

	my $dir = "/proc";

	opendir(DIR, $dir) or die $!;

	while (readdir(DIR)) {

		if (/\d+/) {

			my $pid = $_;

			my @process_dir_stat = stat("$dir/$pid") or next;

			my $uid = $process_dir_stat[4];

			open(CMDLINE, "<$dir/$pid/cmdline");

			binmode CMDLINE;

			my @cmdline = split("\x00", <CMDLINE>);

			return_next({

				id => $pid,

				owner => $uid,

				command => shift(@cmdline),

				arguments => [@cmdline],

				working_dir => readlink("$dir/$pid/cwd")

			});

		}

	}

	return undef;

$$ LANGUAGE plperlu;

CREATE OR REPLACE VIEW processes AS

	SELECT * FROM processes()

;