refgen.pl

#!/usr/bin/perl -w

# Copyright (C) 2012 STRATO.  All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License v2 as published by the Free Software Foundation.
#
# 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, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 021110-1307, USA.

#
# commands:
#
# mkdir <ino> <name> [mode [owner [group]]]
# mkfile <ino> <name> [size [mode [owner [group]]]]
# mksparse <ino> <name> [size [mode [owner [group]]]]
# mknod <ino> <name> <b|c> <major> <minor> [mode [owner [group]]]
# mksymlink <ino> <name> <relative-src> [owner [group]]
# mkfifo <ino> <name> [mode [owner [group]]]
# link <src> <target>
# rename <src> <dst>
# unlink <name>
# rmdir <name>
# write <name> <offset> <length>
# truncate <name> <length>
# mtime <name>
# atime <name>
# chown <name> <uid>[:<gid>]
# chmod <name> <mod>
# truncate <name> [<length>]
# remount
# snapshot

use strict;
use Getopt::Std;
use POSIX qw(mkfifo);
use Fcntl qw(:seek);

my $btrfs = "/usr/local/bin/btrfs";
$| = 1;
select STDERR;
$| = 1;
select STDOUT;

my %opts = ();
my $allok = getopts("b:p:vz:", \%opts);
if (!$allok || !$opts{b} == !$opts{z} || !$opts{p}) {
	die "usage: $0 -p path {-z zfs|-b btrfs}\n";
}

my $path = $opts{p};
my $zfs_name = $opts{z};
my $btrfs_dev = $opts{b};
my @actions = ();
my %inodes = ();

my $actions_i = 0;
while (local $_ = <STDIN>) {
	chomp;
	s/\s+/ /g;
	next if !$_ || $_ eq " " || /^ ?#/;
	push @{$actions[$actions_i]}, [$., $_];
	if (/^(?:snapshot|remount)$/) {
		$actions_i++;
	}
}

my @state;
my $ln;
sub get_path($);
sub tempname($) {
	my $ino = shift;

	die "ino not defined in line $ln\n" unless defined $ino;
	return "$path/tempname-$ino";
}

sub mkpath($) {
	my $p = shift;

	die "path not defined in line $ln\n" unless defined $p;
	die "path $p does not begin with / in line $ln" unless $p =~ /^\//;

	return "$path$p";
}

sub expand_size($) {
	my $size = shift;
	my $e = 1;
	my ($n, $m) = $size =~ /(\d+)([kKmMgGtTpP])?/;
	return $n if (!defined $m);
	$e *= 1024;
	return $n * $e if ($m =~ /[kK]/);
	$e *= 1024;
	return $n * $e if ($m =~ /[mM]/);
	$e *= 1024;
	return $n * $e if ($m =~ /[gG]/);
	$e *= 1024;
	return $n * $e if ($m =~ /[tT]/);
	$e *= 1024;
	return $n * $e if ($m =~ /[pP]/);
	die "invalid qualifier $m in size in line $ln";
}

if ($zfs_name) {
	system("zfs destroy -r $zfs_name");
	system("zfs create -o mountpoint=$path $zfs_name");
	die "zfs create $zfs_name failed\n" if ($?);
} else {
	system("mkfs.btrfs -L refgen-fs $btrfs_dev");
	die "mkfs.btrfs $btrfs_dev failed\n" if ($?);
	system("mount -o noatime,inode_cache $btrfs_dev $path");
	die "mount $btrfs_dev failed\n" if ($?);
}
my $snap = 1;
my %names;

foreach my $a (@actions) {
	my @rules;
	my @makes;

	foreach (@$a) {
		my ($ln, $action) = @$_;
		my ($a, @param) = split / /, $action;
		push @rules, [$ln, $a, @param];
		if ($a =~ /^mk/) {
			@makes[$param[0]] = [$ln, $a, @param];
		}
	}

	#
	# create all files/dirs we need
	#
	my @deletes;
	for my $i (1 ... @makes-1) {
		my $r = $makes[$i];
		if (defined $r) {
			$ln = $r->[0];
			my $a = $r->[1];
			my $ino = $r->[2];
			my $name = tempname($ino);
			my $mode = undef;
			my $owner;
			my $group;
			if ($state[$i]->{created}) {
				die "ino $ino already exist. Consider ".
				    "using remount in line $ln\n";
			}
			print "create $i\n" if $opts{v};
			if ($a eq "mkdir") {
				$mode = $r->[4] || 0750;
				$owner = $r->[5] || "0";
				$group = $r->[6] || "0";
				mkdir($name)
					or die "mkdir($name) failed ".
					       "in line $ln: $!\n";
			} elsif ($a eq "mksymlink") {
				my $src = $r->[4];
				$owner = $r->[5] || "0";
				$group = $r->[6] || "0";
				symlink($src, $name)
					or die "symlink($src, $name) failed ".
					       "in line $ln: $!\n";
			} elsif ($a eq "mkfifo") {
				$mode = $r->[4] || 0750;
				$owner = $r->[5] || "0";
				$group = $r->[6] || "0";
				mkfifo($name, $mode)
					or die "mkfifo($name, $mode) failed ".
					       "in line $ln: $!\n";
			} elsif ($a eq "mkfile" || $a eq "mksparse") {
				my $buf;
				my $size = $r->[4] || 654321;
				$mode = $r->[5] || 0640;
				$owner = $r->[6] || "0";
				$group = $r->[7] || "0";
				$size = expand_size($size);
				open(FH, ">$name")
					or die "creating file $name ".
					       "failed in line $ln: $!\n";
				if ($a eq "mkfile") {
					if ($size > 104857600) {
						die "size > 100M in line $ln\n";
					}
					open(R, "</dev/urandom")
						or die "open /dev/urandom ".
						       "failed: $!\n";
					sysread(R, $buf, $size)
						or die "read from /dev/urandom".
						       " failed: $!\n";
					close(R)
						or die "close /dev/urandom ".
						       "failed: $!\n";
					syswrite(FH, $buf)
						or die "writing to file $name ".
						       "failed in line ".
						       "$ln: $!\n";
				} else {
					seek(FH, $size, SEEK_SET)
						or die "failed to seek to ".
						       "$size in $name at ".
						       "line $ln: $!\n";
					truncate(FH, $size)
						or die "failed to truncate to ".
						       "$size in $name at ".
						       "line $ln: $!\n";
				}
				close(FH)
					or die "closing file $name ".
					       "failed in line $ln: $!\n";
			} elsif ($a eq "mknod") {
				my $buf;
				my $type = $r->[4];
				my $major = $r->[5];
				my $minor = $r->[6];
				$mode = $r->[7] || 0640;
				$owner = $r->[8] || "0";
				$group = $r->[9] || "0";
				system("mknod $name $type $major $minor");
				die "mknod $name $type $major $minor failed ".
				    "in line $ln\n" if ($?);
			} else {
				die "invalid action $a in line $ln\n";
			}
			if (defined $mode) {
				chmod($mode, $name)
					or die sprintf("chmod(0%o, %s) failed ".
						       "in line $ln: $!\n",
						       $mode, $name);
			}
			system("chown", "-h", "$owner:$group", $name);
			die "chown($owner, $group, $name) failed ".
			    "in line $ln\n" if $?;

			$state[$i]->{created} = 1;
			$state[$i]->{links} = 1;
			$state[$i]->{tempname} = $name;
			my $fs_ino = (lstat $name)[1];
			if (!exists $inodes{$ino}) {
				$inodes{$ino} = $fs_ino;
			} elsif ($fs_ino != $inodes{$ino}) {
				die "fatal error: inode $ino became inode ".
				    "$inodes{$ino} earlier, while now ".
				    "(line $ln) it is $fs_ino\n";
			}
		} elsif (!defined $state[$i]->{created}) {
			my $name = tempname($i);

			print "temp create $i\n" if $opts{v};
			mkdir($name)
				or die "creating temp dir $name failed: $!\n";
			push @deletes, $name;
		}
	}
	foreach my $name (@deletes) {
		print "temp delete $name\n" if $opts{v};
		rmdir $name;
	}

	#
	# replay actions
	#
	foreach my $r (@rules) {
		$ln = $r->[0];
		my $a = $r->[1];

		if ($a =~ /^mk/) {
			my $ino = $r->[2];
			my $p = mkpath($r->[3]);
			print "move $ino to $p\n" if $opts{v};
			rename($state[$ino]->{tempname}, $p)
				or die "move $ino to $p failed ".
				       "in line $ln: $!\n";
			delete $state[$ino]->{tempname};
			$state[$ino]->{names}->{$p} = 1;
			$names{$p} = $ino;
		} elsif ($a eq "link") {
			my $source = mkpath($r->[2]);
			my $target = mkpath($r->[3]);
			my $ino = $names{$source};
			die "source $source not found in line $ln\n"
				unless $ino;
			print "link $source to $target\n" if $opts{v};
			link($source, $target)
				or die "link($source, $target) failed ".
				       "in line $ln\n";
			$state[$ino]->{names}->{$target} = 1;
			++$state[$ino]->{links};
			$names{$target} = $ino;
		} elsif ($a eq "rename") {
			my $src = mkpath($r->[2]);
			my $dst = mkpath($r->[3]);
			my $ino = $names{$src};
			die "source $src not found in line $ln\n" unless $ino;
			print "move $src to $dst\n" if $opts{v};
			foreach my $n (sort keys %names) {
				if ($n =~ /^$src(\/.*)/) {
					my $new = $dst.$1;
					my $ino = $names{$n};
					print "rewrite $n to $new, ino $ino\n"
						if $opts{v};
					delete $state[$ino]->{names}->{$n};
					$state[$ino]->{names}->{$new} = 1;
					delete $names{$n};
					$names{$new} = $ino;
				}
				delete $state[$ino]->{names}->{$src};
				$state[$ino]->{names}->{$dst} = 1;
				delete $names{$src};
				$names{$dst} = $ino;
			}
			rename($src, $dst)
				or die "rename $src to $dst failed ".
				       "in line $ln: $!\n";
		} elsif ($a eq "unlink") {
			my $p = mkpath($r->[2]);
			my $ino = $names{$p};
			die "source $p not found in line $ln\n" unless $ino;
			print "unlink $p\n" if $opts{v};
			unlink($p)
				or die "unlink $p failed in line $ln: $!\n";
			delete $names{$p};
			delete $state[$ino]->{names}->{$p};
			if (--$state[$ino]->{links} == 0) {
				print "last ref to ino $ino\n" if $opts{v};
				delete $state[$ino];
			}
		} elsif ($a eq "rmdir") {
			my $p = mkpath($r->[2]);
			my $ino = $names{$p};
			die "source $p not found in line $ln\n" unless $ino;
			print "rmdir $p\n" if $opts{v};
			rmdir($p)
				or die "rmdir $p failed in line $ln: $!\n";
			delete $names{$p};
			delete $state[$ino]->{names}->{$p};
			if (--$state[$ino]->{links} == 0) {
				print "last ref to ino $ino\n";
				delete $state[$ino];
			}
		} elsif ($a eq "write") {
			my $buf;
			my $p = mkpath($r->[2]);
			my $off = $r->[3];
			my $len = $r->[4];
			$len = expand_size($len);
			$off = expand_size($off);
			open(R, "</dev/urandom")
				or die "open /dev/urandom failed: $!\n";
			sysread(R, $buf, $len)
				or die "read from /dev/urandom failed: $!\n";
			close(R)
				or die "close /dev/urandom failed: $!\n";
			open(FH, "+<$p")
				or die "open $p for writing failed ".
				       "in line $ln: $!\n";
			seek(FH, $off, 0)
				or die "seek($p, $off) failed ".
				       "in line $ln: $!\n";
			syswrite(FH, $buf)
				or die "writing to file $p failed ".
				       "in line $ln: $!\n";
			close(FH)
				or die "close of $p failed in line $ln: $!\n";
		} elsif ($a eq "truncate") {
			my $p = mkpath($r->[2]);
			my $size = $r->[3];
			$size = expand_size($size);
			truncate($p, $size)
				or die "truncate $p to $size failed ".
				       "in line $ln: $!\n";
		} elsif ($a eq "chmod") {
			my $p = mkpath($r->[2]);
			my $mode = $r->[3];
			chmod(oct($mode), $p)
				or die "chmod $p to $mode failed ".
				       "in line $ln: $!\n";
		} elsif ($a eq "chown") {
			my $p = mkpath($r->[2]);
			my ($uid, $gid) = (split(/:/, $r->[3]), 0);
			system("chown", "-h", "$uid:$gid", $p);
			die "chown $p to $uid:$gid failed ".
			    "in line $ln\n" if $?;
		} elsif ($a eq "atime") {
			my $p = mkpath($r->[2]);
			qx{touch -a $p};
			if ($?) {
				die "atime update $p failed in line $ln\n";
			}
		} elsif ($a eq "mtime") {
			my $p = mkpath($r->[2]);
			qx{touch -m $p};
			if ($?) {
				die "mtime update $p failed in line $ln\n";
			}
		} elsif ($a eq "truncate") {
			my $p = mkpath($r->[2]);
			my $size = $r->[3] ? $r->[3] : 0;
			truncate($p, $size)
				or die "truncate $p to $size failed ".
				       "in line $ln: $!\n";
		} elsif ($a eq "remount") {
			# ignore
		} elsif ($a eq "snapshot") {
			print "create snapshot $snap\n" if $opts{v};
			if ($zfs_name) {
				system("zfs snapshot $zfs_name\@$snap");
				die "creating snapshot $zfs_name\@$snap ".
				    "failed\n" if ($?);
			} else {
				system("$btrfs subvol snap -r $path ".
				       "$path/\@$snap");
				die "creating snapshot $path\@$snap failed\n"
					if ($?);
			}
			++$snap;
		} else {
			die "invalid action $a in line $ln\n";
		}
	}

	#
	# umount/mount
	#
	if ($zfs_name) {
		system("zfs umount $zfs_name");
		die "zfs umount $zfs_name failed\n" if ($?);
		system("zfs mount $zfs_name");
		die "zfs mount $zfs_name failed\n" if ($?);
	}
}