Programming with Perl | Archiving and Compression with CGI (Web Techniques, Aug

1     #!/usr/bin/perl
2     use strict;
3     $|++;
4     
5     use CGI::Pretty ":standard";
6     use CGI::Carp qw(fatalsToBrowser); # only for debugging
7     $ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";
8     
9     ## CONFIG
10    
11    my $topdir = "/home/merlyn/Web/Bundle";
12    
13    ## END CONFIG
14    
15    chdir $topdir or die "Cannot chdir: $!";
16    
17    ## final pass
18    
19    if (my @names = param('names')) {
20      print header("application/x-tar-gzip");
21      @names = grep !(/^\// or grep /^[-.]/, split /\//), @names;
22      exec "tar", "cfz", "-", @names if @names;
23      die "cannot exec tar: $!";
24    }
25    
26    ## second pass
27    
28    if (my $dist = param('dist')) {
29      $dist =~ / ^ (?! [-.]) ([^\/]+) $ /x and -d $dist 
                and not -l $dist or die "bad dist";
30      $dist = $1;                   # now untainted
31    
32      require File::Find;
33      my @names;
34      File::Find::find
35          (sub {
36             return $File::Find::prune = 1 if /^(-|\..)/s;
37             push @names, $File::Find::name if -f and not -l;
38           }, $dist);
39      print header, start_html("Download a distribution");
40      print h1("Select your items within this distribution");
41    
42      print start_form(-action => url()."/".time().".tar.gz");
43      print p("Select your items:");
44      print
45        table({cellspacing => 0, cellpadding => 2, border => 0},
46              Tr(th(["Filename",
47                     "Size",
48                     "Last modified"])),
49              map Tr(td([checkbox("names", 1, $_, $_),
50                         sprintf("%dK", (1023 + -s)/1024),
51                         scalar(localtime +(stat)[9])])),
52              @names);
53      print submit;
54      print end_form, end_html;
55      exit 0;
56    }
57    
58    ## first pass
59    
60    print header, start_html("Download a distribution");
61    print h1("Select your distribution");
62    
63    opendir DOT, "." or die "Cannot opendir: $!";
64    my @names = sort grep !/^[-.]/ && -d && ! -l, readdir DOT;
65    closedir DOT;
66    print start_form, p("Select your distribution:");
67    print radio_group(-name => "dist", -values => \@names, 
                        -columns => 1);
68    print submit;
69    print end_form, end_html;
70    exit 0;