Subject: Re: LS or DIR in Perl

From: Barr3y Jaspan <[email-masked]>
Date: Wed, 29 Apr 1992 21:54:41 GMT

|> Does anyone know whether a version of the UNIX 'ls' command 
|> has been written in Perl (with all the standard options).

Well, this isn't exactly what you asked for, but I thought people
might find it amusing or useful.  It is a program that performs the
equivalent of "ls -lagi" by grovelling over the raw device and parsing
the file system data structures directly.

Some parts of the program will be useful to someone writing a normal
ls in perl.  Most of it won't be.  Of course, you have to be root to
run this.  Have fun! :-)

Barr3y Jaspan, [email-masked]

--- snip snip ---

#!/usr/bin/perl

require 'ufs/ufs_inode.ph';
require 'sys/stat.ph';

sub byteorder { if (pack("s",1) != pack("n",1)) { "big"; } else { "little"; }}

#
# General ufs stuff
#

# compute disk addresses for data in cylinder groups
sub cgbase { $fpg * $_[0]; }
sub cgstart { &cgbase($_[0]) + $cgoffset * ($_[0] & ~$cgmask); }
sub cgimin { &cgstart($_[0]) + $iblkno; }

# compute absolute  offset (seek address) from inode
sub itoofs { $x=&cgimin(int($_[0]/$ipg))*$fsize + ($_[0]%$ipg)*128; $x;}

$rootino = 2;
$dev_bsize = 512;
$sb_size = 8192;
$sb_addr = 8192;
$maxmntlen = 512;

# Open the character device, read the superblock, extract some useful
# fields
$device = shift @ARGV || die "No device specified";
open(DEV, $device) || die "Cannot open $device: $!";
seek(DEV, $sb_addr, 0) || die "Cannot seek to superblock: $!";
sysread(DEV, $sblock, $sb_size) || die "Cannot read superblock: $!";

($sblkno, $cblkno, $iblkno, $dblkno, $cgoffset, $cgmask, $bsize,
	$fsize, $frag, $fragshift, $cpg, $ipg, $fpg) = 
	(unpack("L52x4a$maxmntlen",$sblock))[2,3,4,5,6,7,12,13,14,24,45,46,47];

$print_disk_parameters = 1;
if ($print_disk_parameters) {
print <<EOD;
$device parameters:
\$sblkno =   $sblkno;
\$cblkno =   $cblkno;
\$iblkno =   $iblkno;
\$dblkno =   $dblkno;
\$cgoffset = $cgoffset;
\$cgmask =   $cgmask;
\$bsize =    $bsize;
\$fsize =    $fsize;
\$frag =     $frag;
\$cpg =	     $cpg;
\$ipg =      $ipg;
\$fpg =      $fpg;
\$fragshift= $fragshift;
----
EOD
}

#
# Inode stuff
#
# The array returned by get_inode is:
# ($mode, $nlink, $uid, $gid, $size, $atime, $mtime, $itime, @ndaddr, @niaddr)
#

$ndaddr = &NDADDR;
$niaddr = &NIADDR;

# The size is stored as a longlong; one long is (virutally) always
# zero, but which one it is depends on byte order
if (&byteorder eq "little") {
	$inode_tmpl = "SsssLx4Lx4Lx4Lx4L${ndaddr}L${niaddr}x4L";
} else {
	$inode_tmpl = "Ssssx4LLx4Lx4Lx4L${ndaddr}L${niaddr}x4L";
}

sub get_inode {
	local($inode);
	seek(DEV, &itoofs($_[0]), 0);
	if (sysread(DEV, $inode, 128) != 128) {
		die "Cannot read full inode $_[0]: $!";
	}
	unpack($inode_tmpl, $inode);
}

#
# Now, ls-specific stuff
#

@types = ("X", "?", "c", "X", "d", "X", "b", "X", "-", "X", "l", "X", "s");
@perms = ("---", "--x", "-w-", "-wx", "r--", "r-x", "rw-", "rwx");

# Convert a mode-type short to string
sub mode2str {
	local($mode, $str) = @_;
	$str = $types[($mode & &S_IFMT) >> 12]
		. $perms[($mode & 0700) >> 6]
		. $perms[($mode & 0070) >> 3]
		. $perms[$mode & 07];
	substr($str, 3, 1) = "s" if ($mode & &S_ISUID);
	substr($str, 5, 1) = "s" if ($mode & &S_ISGID);
	substr($str, 9, 1) = "t" if (($mode & &S_ISVTX) &&
		(($mode & &S_IFMT) == &S_IFDIR));
	return $str;
}

# read a link's first block to find where it points
sub do_link {
	local($ino) = @_;
	local($db, $name) = (&get_inode($ino))[8];

	seek(DEV, $db*$fsize, 0);
	sysread(DEV, $name, 255); # XXX 255 should be maxnamlen
	return " -> $name";
}

# scan through a directory printing each entry
sub do_dir {
	local($mode, @db) = (&get_inode($_[0]))[0, 8..8+$ndaddr];
	local($ino, $reclen, $nlen, $name, $p);
	
	for $db (@db) {
		last if $db == 0;

		$p = 0;
		seek(DEV, $db*$fsize, 0);
		sysread(DEV, $block, $dev_bsize);
		while ($p != $dev_bsize) {
			($ino, $reclen, $nlen) = unpack("LSS",
				(substr($block, $p, 8)));
			$name = substr($block, $p + 8, $nlen);
			&ls_file($ino, $name);
			$p += $reclen;
		}
	}
}

# return the inode # for a specific file in a directory
sub find_file {
	local($dir_ino, $find) = @_;
	local($ino, $reclen, $nlen, $name, $p);
	local($mode, @db) = (&get_inode($dir_ino))[0, 8..8+$ndaddr];

	for $db (@db) {
		return "" if $db == 0;

		$p = 0;
		seek(DEV, $db*$fsize, 0);
		sysread(DEV, $block, $dev_bsize);
		while ($p != $dev_bsize) {
			($ino, $reclen, $nlen) = unpack("LSS",
				(substr($block, $p, 8)));
			$name = substr($block, $p + 8, $nlen);
			$p += $reclen;
			return $ino if $name eq $find;
		}
	}
}

# print an ls line, given an inode and a name
sub ls_file {
	local($ino, $name) = @_;
	($mode, $nlink, $uid, $gid, $size, $dummy, $mtime) = &get_inode($ino);
	$own = (getpwuid($uid))[0];
	$own = $uid if ($own eq "");
	$grp = (getgrgid($gid))[0];
	$grp = $gid if ($grp eq "");
	$name .= &do_link($ino) if (($mode & &S_IFMT) == &S_IFLNK);
	printf("%6d %s %2d %-8s %-8s %8u %d %s\n",
		$ino, &mode2str($mode), $nlink, $own, $grp,
		$size, $mtime, $name);
}

for (@ARGV) {
	@comps = split(/\//, $_);
	shift @comps;
	$ino = 2;
	for $dir (@comps) {
		$ino = &find_file($ino, $dir);
	}
	&do_dir($ino);
}