bin/l

   1 #!/usr/bin/perl -w
   2 #
   3 # l / ll / lf / llf -  better replacement of the classic ls command
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6 #
   7 # Perl Artistic License
   8
   9 use Cwd qw'abs_path';
  10 use File::Basename;
  11 use Getopt::Std;
  12
  13 # the name of the game
  14 $0 =~ s:.*/::;
  15
  16 $ENV{LC_ALL} = 'C';
  17
  18 # unshift @ARGV,split /\s+/,$ENV{'l_opt'} if $ENV{'l_opt'};
  19
  20 @ARGV = grep { chomp } <STDIN> if "@ARGV" eq '-';
  21
  22 # parse CLI arguments
  23 $opt_l = $opt_i = $opt_t = $opt_s = $opt_a = $opt_r = $opt_d = $opt_n = 0;
  24 $opt_L = $opt_N = $opt_c = $opt_u = $opt_S = $opt_R = $opt_z = $opt_h = 0;
  25 $opt_U = $opt_x = $opt_E = 0;
  26 ${'opt_*'} = 0;
  27 $opt_m = $opt_f = $opt_F = $opt_D = '';
  28 getopts('hdnlLNitcuarsxUSREz*m:f:D:F:') or usage(1);
  29 usage(0) if $opt_h;
  30 $opt_z = 1 unless $opt_R;
  31 $opt_l = 1                            if $0 eq 'll';
  32 $opt_l = $opt_i = $opt_a = $opt_S = 1 if $0 eq 'lll';
  33 &examples if $opt_E;
  34 if ($0 eq 'lf' or $0 eq 'llf') {
  35   $opt_l = $0 eq 'llf';
  36   if (scalar(@ARGV) == 0) {
  37     die usage(1);
  38   } elsif (scalar(@ARGV) == 1) {
  39     $opt_F = shift;
  40     $opt_R = $opt_F if $opt_F eq '.';
  41   } elsif (-d $ARGV[-1]) {
  42     $opt_R = pop(@ARGV);
  43     $opt_F = join('|',@ARGV);
  44   } else {
  45     $opt_F = join('|',@ARGV);
  46   }
  47   @ARGV = ();
  48   @ARGV = ($opt_R) if -d $opt_R;
  49 }
  50
  51 $postsort = $opt_t||$opt_s;
  52 $postproc = $postsort||$opt_z;
  53
  54 # mark for squeeze operation
  55 $z = $opt_z ? "\0" : '';
  56
  57 # default sorting methode
  58 if    ($opt_U) { $lcsort = sub { return @_ } }
  59 elsif ($opt_r) { $lcsort = sub { sort { lc $b cmp lc $a } @_ } }
  60 else           { $lcsort = sub { sort { lc $a cmp lc $b } @_ } }
  61
  62 # default: list only files not beginning with a dot
  63 unless ($opt_m) {
  64   if ($opt_a) { $opt_m = '.' }
  65   else        { $opt_m = '^[^\.]' }
  66 }
  67
  68 $older = $newer = 0;
  69
  70 if ($opt_D) {
  71   if ($opt_D =~ /:(\d+)([mhd])/) {
  72     $older = $1;
  73     my $z = $2 || 's';
  74     if    ($z =~ /m/) { $older *= 60 }
  75     elsif ($z =~ /h/) { $older *= 60*60 }
  76     elsif ($z =~ /d/) { $older *= 60*60*24 }
  77   } elsif ($opt_D =~ /:(\d\d\d\d-\d\d-\d\d)$/) {
  78     $older = $1;
  79   }
  80   if ($opt_D =~ /(\d+)([mhd]):/) {
  81     $newer = $1;
  82     my $z = $2 || 's';
  83     if    ($z =~ /m/) { $newer *= 60 }
  84     elsif ($z =~ /h/) { $newer *= 60*60 }
  85     elsif ($z =~ /d/) { $newer *= 60*60*24 }
  86   } elsif ($opt_D =~ /^(\d\d\d\d-\d\d-\d\d):/) {
  87     $newer = $1;
  88   }
  89 }
  90
  91 # preselect date field number
  92 if    ($opt_c) { $sdf = 'c' }
  93 elsif ($opt_u) { $sdf = 'a' }
  94 else           { $sdf = 'm' }
  95
  96 # any arguments?
  97 if (@ARGV) { @ARGV = &$lcsort(@ARGV) }
  98 else       { @ARGV = &getfiles('.') }
  99
 100 # build files list
 101 &collect(@ARGV);
 102
 103 # post process files list?
 104 # remark: if no postprocessing, files list has been already printed in list()
 105 if (@LIST && $postproc) {
 106
 107   # on -t or -s option sort list on date or size
 108   # and then strip of leading sorting pre-string
 109   @LIST = grep { s/.{21}// } reverse sort @LIST if $postsort;
 110
 111   # squeeze size field (= remove unnecessary spaces)
 112   if ($opt_z and not $opt_f) {
 113     $opt_z = '%'.$opt_z.'s ';
 114     @LIST = grep { s/\0 *([,\d\.\-]+) /sprintf($opt_z,$1)/e } @LIST;
 115   }
 116
 117   @LIST = reverse @LIST if $opt_r;
 118
 119   if (not ($opt_t or $opt_U) and grep /^d[rR-][wW-][xX-]/,@LIST) {
 120     foreach (@LIST) { print if /^d/ }
 121     foreach (@LIST) { print unless /^d/ }
 122   } else {
 123     print @LIST;
 124   }
 125 }
 126
 127 # print statistics summary?
 128 if ($opt_S && $SS) {
 129   print "$SS file(s):";
 130   printf " r=%d (%s Bytes)",$SS{'-'},&d3($Ss) if $SS{'-'};
 131   delete $SS{'-'};
 132   foreach my $type (qw(l d c b p s ?)) {
 133     printf " %s=%d",$type,$SS{$type} if $SS{$type};
 134     delete $SS{$type};
 135   }
 136   foreach my $type (keys %SS) { printf " %s=%d",$type,$SS{$type} }
 137   print "\n";
 138 }
 139
 140 exit ($found ? 0 : 1);
 141
 142
 143 # collect files and build file lists
 144 #
 145 # INPUT: filenames
 146 #
 147 # GLOBAL: @LIST
 148 sub collect {
 149   my @files = @_;
 150   my $f;
 151
 152   getacl(@files) if $opt_l and not $opt_n;
 153
 154   # loop over all argument files/directories
 155   foreach $f (@files) {
 156
 157     # skip jed and emacs backup files
 158     # next if $f =~ /~$/ and not $opt_a and not $opt_l;
 159
 160     # recursive?
 161     if ($opt_R) {
 162
 163       # list single file
 164       if ($opt_L) {
 165         unless (-e $f) {
 166           warn "$0: dangling symlink $f\n";
 167           next;
 168         }
 169         $f = abs_path($f);
 170       }
 171       list($f);
 172
 173       # traverse real subdirs
 174       if (-d $f and not -l $f) {
 175         $f =~ s:/*$:/:;
 176         # skip other file systems on -x
 177         if ($opt_x) {
 178           my @pd = stat(dirname($f));
 179           my @sd = stat($f);
 180           next if $pd[0] ne $sd[0];
 181         }
 182         collect(getfiles($f));
 183       }
 184
 185     } else {
 186
 187       # suppress trailing / on -d option
 188       $f =~ s:/$:: if $opt_d;
 189
 190       # on trailing / list subdirs, too
 191       if ($f =~ m:/$:) { list(getfiles($f)) }
 192       elsif ($f eq '') { list('/') }
 193       else {
 194         if ($opt_L) {
 195           unless (-e $f) {
 196             warn "$0: dangling symlink $f\n";
 197             next;
 198           }
 199           $f = abs_path($f);
 200         }
 201         list($f);
 202       }
 203
 204     }
 205   }
 206 }
 207
 208
 209 # list file(s)
 210 #
 211 # INPUT: filenames
 212 #
 213 # GLOBAL: @LIST (filenames-list)
 214 sub list {
 215   my @files = @_;
 216   my ($file,$line,$linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
 217   my ($day);
 218
 219   foreach $file (@files) {
 220
 221     next if $opt_F and not fmatch($file);
 222     next if $opt_N and (not -f $file or -l $file);
 223
 224     # get file information
 225     # if ($opt_L and stat $file or not $opt_L and lstat $file) {
 226     if (lstat $file) {
 227       ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates) = &info($file);
 228     } elsif ($! eq "Permission denied") {
 229       $linkname = $file;
 230       $inode = $links = $size = $uid = $gid = '?';
 231       $mode = $opt_l ? '?---------' : '?---';
 232       $date = '????-??-?? ??:??:??';
 233       %dates = ('m' => 0, 'a' => 0, 'c' => 0);
 234     } else {
 235       warn "$0: ".quote($file)." - $!\n";
 236       next;
 237     }
 238
 239     $day = $date;
 240     $day =~ s/\s.*//;
 241
 242     if ($older) {
 243       next if $older =~ /-/ and $day gt $older;
 244       next if $older !~ /-/ and $dates{m} > time-$older;
 245     }
 246     if ($newer) {
 247       next if $newer =~ /-/ and $day lt $newer;
 248       next if $newer !~ /-/ and $dates{m} < time-$newer;
 249     }
 250
 251     if (defined $linkname) {
 252
 253       # prepend sorting string
 254       $line = '';
 255       $line = sprintf '%21s',$date if $opt_t;
 256       $line = sprintf '%21s',$size if $opt_s;
 257
 258       unless ($opt_n) {
 259         $uid = substr($uid,0,8);
 260         $gid = substr($gid,0,8);
 261       }
 262
 263       # user defined format?
 264       if ($opt_f) {
 265         foreach my $i (split '',$opt_f) {
 266           if ($opt_n) {
 267             $i =~ tr/AD/ad/;
 268             if    ($i eq 'm') { $line .= sprintf '%06o ',  $mode }
 269             elsif ($i eq 'u') { $line .= sprintf '%6d ',   $uid }
 270             elsif ($i eq 'g') { $line .= sprintf '%6d ',   $gid }
 271             elsif ($i eq 's') { $line .= sprintf "$z%16s ",$size }
 272             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
 273             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
 274             elsif ($i eq 'd') { $line .= sprintf '%10s ',  $date }
 275             elsif ($i eq 'a') { $line .= sprintf '%10s %10s %10s ',
 276                                          $dates{'a'},$dates{'m'},$dates{'c'} }
 277           } else {
 278             # $mode =~ s/(....)(...)/sprintf($1.uc($2))/e if $ACL{$file};
 279             substr($mode,4,3) = uc(substr($mode,4,3)) if $ACL{$file};
 280             if    ($i eq 'm') { $line .= $mode.' ' }
 281             elsif ($i eq 'u') { $line .= sprintf '%-8s ',  $uid }
 282             elsif ($i eq 'g') { $line .= sprintf '%-8s ',  $gid }
 283             elsif ($i eq 's') { $line .= sprintf "$z%19s ",$size }
 284             elsif ($i eq 'l') { $line .= sprintf '%3s ',   $links }
 285             elsif ($i eq 'i') { $line .= sprintf '%14s ',  $inode }
 286             elsif ($i eq 'd') { $line .= $date.' ' }
 287             elsif ($i eq 'D') { $line .= $date.' ' }
 288             elsif ($i eq 'a') { $line .= &isodate($dates{'a'}).' '.
 289                                          &isodate($dates{'m'}).' '.
 290                                          &isodate($dates{'c'}).' ' }
 291             elsif ($i eq 'A') { $line .= &isodate($dates{'a'}).' '.
 292                                          &isodate($dates{'m'}).' '.
 293                                          &isodate($dates{'c'}).' ' }
 294           }
 295         }
 296
 297       # predefined formats
 298       } else {
 299
 300         if ($opt_n) {
 301           if ($opt_l) {
 302             $line .= sprintf "%06o %6d %6d $z%15s %10d ",
 303                              $mode,$uid,$gid,$size,$date;
 304           } else {
 305             $line .= sprintf "%06o $z%15s %10d ",$mode,$size,$date;
 306           }
 307         } else {
 308           if ($opt_l) {
 309             # $mode .= $ACL{$file} ? '+' : ' ';
 310             # $mode =~ s/(....)(...)/sprintf($1.uc($2))/e if $ACL{$file};
 311             substr($mode,4,3) = uc(substr($mode,4,3)) if $ACL{$file};
 312             $line .= sprintf "%s %-8s %-8s $z%19s %s ",
 313                              $mode,$uid,$gid,$size,$date;
 314           } else {
 315             $line .= sprintf "%s $z%19s %s ",$mode,$size,substr($date,0,-3);
 316           }
 317         }
 318
 319         if ($opt_i)   { $line .= sprintf '%3s %10s ',$links,$inode }
 320       }
 321
 322       $line .= $linkname."\n";
 323
 324       if ($postproc) {
 325         push @LIST,$line;
 326       } else {
 327         $line =~ s/\0//;
 328         print $line;
 329       }
 330       $found++;
 331
 332     } else {
 333       lstat $file;
 334       warn "$0: cannot get dir-info for ".quote($file)." - $!\n";
 335     }
 336
 337   }
 338 }
 339
 340 # get file information
 341 #
 342 # INPUT: file name
 343 #
 344 # OUTPUT: filename with linkname, inode, hard link count, size, mode string,
 345 #         UID, GID, isodate
 346 sub info {
 347   my $file = shift;
 348   my ($linkname,$links,$mode,$bmode,$uid,$gid,$date,%dates,@stat);
 349   my $size = '-';
 350   my $inode = '?';
 351   my @rwx = qw/--- --x -w- -wx r-- r-x rw- rwx/;
 352   my $type;
 353
 354   if ($opt_L) { @stat = stat $file }
 355   else        { @stat = lstat $file }
 356
 357   if (@stat) {
 358
 359     $inode = $stat[1];
 360     $bmode = $stat[2];
 361     $links = $stat[3];
 362     %dates = ('m' => $stat[9],
 363               'a' => $stat[8],
 364               'c' => $stat[10]);
 365
 366     if ($opt_n) {
 367       $uid  = $stat[4];
 368       $gid  = $stat[5];
 369       $date = $dates{$sdf};
 370     } else {
 371       $uid  = getpwuid($stat[4]) || $stat[4];
 372       $gid  = getgrgid($stat[5]) || $stat[5];
 373       $date = &isodate($dates{$sdf});
 374     }
 375
 376     if    (-f _)            { $type = '-'; $size = $stat[7]; }
 377     elsif (!$opt_L && -l _) { $type = 'l'; }
 378     elsif (-d _)            { $type = 'd'; }
 379     elsif (-c _)            { $type = 'c'; $size = &nodes($stat[6]); }
 380     elsif (-b _)            { $type = 'b'; $size = &nodes($stat[6]); }
 381     elsif (-p _)            { $type = 'p'; }
 382     elsif (-S _)            { $type = 's'; }
 383     else                    { $type = '?'; }
 384
 385     if ($opt_n) {
 386       $mode = $stat[2];
 387       $size = $stat[7] if $size eq '-';
 388     } else {
 389       if ($opt_l) {
 390         $mode = $rwx[$bmode & 7];
 391         $bmode >>= 3;
 392         $mode = $rwx[$bmode & 7] . $mode;
 393         $bmode >>= 3;
 394         $mode = $rwx[$bmode & 7] . $mode;
 395         substr($mode,2,1) =~ tr/-x/Ss/ if -u _;
 396         substr($mode,5,1) =~ tr/-x/Ss/ if -g _;
 397         substr($mode,8,1) =~ tr/-x/Tt/ if -k _;
 398         $mode = $type.$mode;
 399       } else {
 400         # with short list display only effective file access modes
 401         use filetest 'access'; # respect ACLs ==> cannot use pseudofile _
 402         $mode = $type
 403                 . (-r $file ? 'R' : '-')
 404                 . (-w $file ? 'W' : '-')
 405                 . (-x $file ? 'X' : '-');
 406         substr($mode,2,1) =~ tr/-x/Ss/ if -u $file or -g $file;
 407         substr($mode,3,1) =~ tr/-x/Tt/ if -k $file;
 408       }
 409     }
 410
 411   # fall back to ls command if perl lstat failed
 412   } else {
 413     if ($opt_L) {
 414       return;
 415     } else {
 416       ($mode,$links,$uid,$gid,$size) = split /\s+/,`ls -ld $file 2>/dev/null`;
 417       return undef unless defined $mode;
 418       $type = substr($mode,0,1);
 419       # for (my $i=0;$i<3;$i++) { push @dates,'????-??-?? ??:??:??' }
 420       # $date = `gfind $dir -maxdepth 1 -name $file -printf '%Ty-%Tm-%Td %TT\n'`;
 421     }
 422   }
 423
 424   # summarize statistics
 425   if ($opt_S) {
 426     $SS++;
 427     $SS{$type}++;
 428     $Ss += $size if $type eq '-';
 429   }
 430
 431   $size = &d3($size);
 432
 433   # determine longest size field
 434   if ($opt_z) {
 435     my $x = length $size;
 436     $opt_z = $x if $x>$opt_z;
 437   }
 438   $linkname = ${'opt_*'} ? $file : quote($file) ;
 439   if ($type eq 'l' and $opt_f !~ /n/) {
 440     my $link = readlink($file);
 441     if (defined $link) {
 442       $linkname .= ' -> ' . (${'opt_*'} ? $link : quote($link));
 443     }
 444   }
 445   $mode =~ s/\+$//;
 446   #$mode .= ' ' unless $mode =~ /\+$/;
 447
 448   return ($linkname,$inode,$links,$size,$mode,$uid,$gid,$date,%dates);
 449 }
 450
 451 # get ACLs
 452 #
 453 # INPUT: filenames
 454 #
 455 # GLOBAL: @ACL
 456 sub getacl {
 457   my @files;
 458
 459   $getfacl ||= pathsearch('getfacl') or return;
 460   # warn "### @_\n";
 461   foreach my $file (@_) { push @files,$file if -e $file }
 462   if (@files and open my $acl,'-|',$getfacl,'-ps',@files) {
 463     while (<$acl>) {
 464       $ACL{$1} = $1 if /^# file: (.+)/;
 465     }
 466     close $acl;
 467   }
 468 }
 469
 470
 471 # reformat integer into 3-digit doted format
 472 # (when non-numerical mode is set)
 473 #
 474 # INPUT: integer or '-'
 475 #
 476 # OUTPUT: d3-string
 477 sub d3 {
 478   local $_ = shift;
 479   if ($opt_n) { s/-/0/ }
 480   else        { while (s/(\d)(\d\d\d\b)/$1,$2/) {} }
 481   return $_;
 482 }
 483
 484
 485 # get all files matching pattern $opt_m
 486 #
 487 # INPUT: directory to scan
 488 #
 489 # OUTPUT: files which match (sorted, directories first)
 490 sub getfiles {
 491   my $dir = shift;
 492   my @files = ();
 493   my @dirs = ();
 494   my $f;
 495
 496   if (opendir D,$dir) {
 497     $dir = '' if $dir eq '.';
 498     while (defined($f = readdir D)) {
 499
 500       # skip . and .. pseudo-subdirs
 501       next if $f =~ m:(^|/)\.\.?/*$:;
 502       # skip ONTAP snapshot dir
 503       next if $f =~ m:(^|/)\.snapshot/*$:;
 504
 505
 506       # skip jed and emacs backup files
 507       # next if $f =~ /~$/ and not $opt_a and not $opt_l;
 508
 509       if ($f =~ /$opt_m/) {
 510         my $x = $dir.$f;
 511         if (not -l $x and -d $x and not ($opt_R or $postsort or $opt_U)) {
 512           push @dirs,$x;
 513         } else {
 514           push @files,$x;
 515         }
 516       }
 517     }
 518     closedir D;
 519     unless ($postsort) {
 520       @files = &$lcsort(@files);
 521       @dirs  = &$lcsort(@dirs);
 522     }
 523   } else {
 524     warn "$0: cannot read $dir : $!\n";
 525   }
 526
 527   getacl(@dirs,@files) if $opt_l and not $opt_n;
 528   return (@dirs,@files);
 529 }
 530
 531
 532 # reformat integer to string node
 533 #
 534 # INPUT: integer node
 535 #
 536 # OUTPUT: string node
 537 sub nodes {
 538   my $rdev = shift;
 539   return sprintf("%03d,%03d", ($rdev >> 8) & 255, $rdev & 255);
 540 }
 541
 542
 543 sub pathsearch {
 544   my $prg = shift;
 545
 546   foreach my $dir (split(':',$ENV{PATH})) {
 547     return "$dir/$prg" if -x "$dir/$prg";
 548   }
 549 }
 550
 551
 552 # reformat timetick to ISO date string
 553 #
 554 # INPUT: timetick
 555 #
 556 # OUTPUT: ISO date string
 557 sub isodate {
 558   my @d = localtime shift;
 559   return sprintf('%d-%02d-%02d %02d:%02d:%02d',
 560                  $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
 561 }
 562
 563
 564 # quote file name to printable name and escape shell meta chars
 565 #
 566 # INPUT: original file name
 567 #
 568 # OUTPUT: printable file name
 569 sub quote {
 570   local $_ = shift;
 571   my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};';
 572
 573   unless (defined $_) {
 574     die "@_";
 575     @x = caller;
 576     die "@x";
 577   }
 578   if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) {
 579     s/([$mc])/\\$1/g;
 580     s/^~/\\~/;
 581 # } elsif (/[$mc]/ or -d and /:/) {
 582   } elsif (/[$mc]/) {
 583     $_ = "'$_'";
 584   }
 585   return $_;
 586 }
 587
 588
 589 sub fmatch {
 590   my $file = shift;
 591   my $link = readlink($file)||'';
 592
 593   return $file if basename($file) =~ /$opt_F/i;
 594   return $link if basename($link) =~ /$opt_F/i;
 595 }
 596
 597
 598 sub usage {
 599   my $status = shift;
 600   my $opts = '[-lastcuidnrzLRxNS*] [-f format] [-D X:Y]';
 601   local *OUT = $status ? *STDERR : *STDOUT;
 602
 603   if ($0 ne 'lf') {
 604     print OUT "usage: $0 $opts [-F regexp] [file...]\n";
 605   }
 606   $opts =~ s/R//;
 607   print OUT "usage: lf $opts regexp [regexp...] [directory]\n";
 608   print OUT <<EOD;
 609 options: -l  long list (implicit if called 'll')
 610          -a  list also .* files
 611          -s  sort by size
 612          -t  sort by time
 613          -U  sort by nothing (original i-node order)
 614          -c  list status change time instead of modification time
 615          -u  list last access time instead of modification time
 616          -i  list also inode and hard links numbers
 617          -d  do not list contents of diretories
 618          -n  numerical output
 619          -r  reverse list
 620          -z  squeeze size field (slows down output)
 621          -L  show absolute real path (dereference symbolic links)
 622          -R  recursive into subdirs
 623          -x  do not cross filesystem boundaries with -R
 624          -F  find files matching case insensitive regexp
 625          -N  show only normal (regular) files
 626          -S  print statistics summary at end
 627          -*  list plain file names (without \\ masking)
 628          -f  user defined format output, format characters are:
 629              m=mode, u=user, g=group, s=size, l=hard links count, i=inode
 630              n=name only, d=date, a=access+modification+inodechange dates
 631          -D  list only files newer than X and older than Y
 632              XY format: NUMBER[smhd] (s=seconds, m=minutes, h=hours, d=days)
 633              XY format: YYYY-MM-DD (Y=year, M=month, D=day)
 634          -E  show examples
 635 EOD
 636   exit $status;
 637 }
 638
 639 sub examples {
 640   print <<EOD;
 641 l *.c            # list files ending with .c
 642 l -la            # list all files in long format
 643 l -Rrs           # list files recursive reverse sorted by size
 644 l -*f mus        # list files native names with format: mode+user+size
 645 l -D 10d:        # list files newer than 10 days
 646 ll               # list files long format (equal to: l -l)
 647 lll              # list files extra long format (equal to: l -liS)
 648 lf 'status.*mp3' # list files matching regexp (equal to: l -F 'status.*mp3')
 649 lf sda1 /dev     # list devices matching sda1 (equal to: l -RF sda1 /dev)
 650 EOD
 651   exit;
 652 }