chiark / gitweb /
automatic agpl compliance: wip fixes
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 18 Feb 2013 16:57:21 +0000 (16:57 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 18 Feb 2013 16:57:21 +0000 (16:57 +0000)
CGI/Auth/AGPLv3 [new symlink]
cgi-auth-flexible.pm

diff --git a/CGI/Auth/AGPLv3 b/CGI/Auth/AGPLv3
new file mode 120000 (symlink)
index 0000000..97d4185
--- /dev/null
@@ -0,0 +1 @@
+../../AGPLv3
\ No newline at end of file
index 4dd6daf2ddaca6fdc0c433cf26a7960b86593f0a..a462bf8434f79f2e0f0190565ebfed908ff2e4af 100644 (file)
@@ -200,15 +200,15 @@ sub gen_plain_footer_html ($$) {
 
 #---------- licence and source code ----------
 
-sub srcdump_dump_thing ($$$) {
-    my ($c,$r, $thing, $outfn) = @_;
+sub srcdump_dump ($$$) {
+    my ($c,$r, $thing) = @_;
     die if $thing =~ m/\W/ || $thing !~ m/\w/;
     my $path = $r->_get_path('srcdump');
     my $ctf = new IO::File "$path/$thing.ctype", 'r'
        or die "$path/$thing.ctype $!";
     my $ct = <$ctf>;
     chomp $ct or die "$path/$thing ?";
-    $ct->close or die "$path/$thing $!";
+    $ctf->close or die "$path/$thing $!";
     my $df = new IO::File "$path/$thing.data", 'r'
        or die "$path/$thing.data $!";
     $r->_ch('dump', $ct, $df);
@@ -216,7 +216,7 @@ sub srcdump_dump_thing ($$$) {
 
 sub dump_plain ($$$$) {
     my ($c, $r, $ct, $df) = @_;
-    $r->_print($c->header(-type $ct));
+    $r->_print($c->header('-type' => $ct));
     my $buffer;
     for (;;) {
        my $got = read $df, $buffer, 65536;
@@ -268,7 +268,7 @@ sub srcdump_byvcs_git ($$$$$) {
                             ");
 }
 
-sub scrdump_dir_cpio ($$$$$) {
+sub srcdump_dir_cpio ($$$$$) {
     my ($c,$v,$dumpdir,$dir,$tarballcounter,$script) = @_;
     my $outfile = "$dumpdir/$$tarballcounter.tar";
     my $pid = fork();
@@ -296,11 +296,12 @@ sub scrdump_dir_cpio ($$$$$) {
 sub srcdump_dirscan_prepare ($$) {
     my ($c, $v) = @_;
     my $dumpdir = $v->_get_path('srcdump');
+    mkdir $dumpdir or $!==&EEXIST or die "mkdir $dumpdir $!";
     my $lockf = new IO::File "$dumpdir/generate.lock", 'w+'
        or die "$dumpdir/generate.lock $!";
     flock $lockf, LOCK_EX or die "$dumpdir/generate.lock $!";
     my $needlicence = "$dumpdir/licence.tmp";
-    unlink $needlicence || $!==&ENOENT or die "rm $needlicence $!";
+    unlink $needlicence or $!==&ENOENT or die "rm $needlicence $!";
     if (defined $v->{S}{srcdump_licence_path}) {
        copy($v->{S}{srcdump_licence_path}, $needlicence)
            or die "$v->{S}{srcdump_licence_path} $!";
@@ -309,7 +310,7 @@ sub srcdump_dirscan_prepare ($$) {
     my $srctarballcounter = 'aaa';
     my %dirsdone;
     my @srcfiles = ("$dumpdir/licence.data");
-    foreach my $incdir ($v->_ch('getsource_includedirs')) {
+    foreach my $incdir ($v->_ch('srcdump_includedirs')) {
        if (defined $needlicence) {
            foreach my $try (@{ $v->{S}{srcdump_licence_files} }) {
                last if copy("$incdir/$try", $needlicence);
@@ -394,11 +395,13 @@ sub new_verifier {
            gen_login_form => \&gen_plain_login_form,
            gen_login_link => \&gen_plain_login_link,
            gen_postmainpage_form => \&gen_postmainpage_form,
-           srcdump_dump_thing => \&srcdump_dump_thing,
+           srcdump_dump => \&srcdump_dump,
            srcdump_prepare => \&srcdump_dirscan_prepare,
            srcdump_licence_path => undef,
            srcdump_licence_files => [qw(AGPLv3 CGI/Auth/Flexible/AGPLv3)],
+           srcdump_includedirs => sub { return @INC; },
            srcdump_system_dir => sub { $_[2] =~ m#^/etc/|^/usr/(?!local/)#; },
+           srcdump_process_dir => \&srcdump_process_dir,
            srcdump_vcs_dirs => [qw(.git .hg .svn CVS)],
            srcdump_byvcs_git => \&srcdump_byvcs_git,
            srcdump_byvcs_hg => \&srcdump_byvcs_hg,
@@ -406,6 +409,7 @@ sub new_verifier {
            srcdump_byvcs_cvs => \&srcdump_byvcs_cvs,
            srcdump_novcs => \&srcdump_novcs,
            srcdump_excludes => [qw(*~ *.bak *.tmp), '#*#'],
+           dump => \&dump_plain,
            gettext => sub { gettext($_[2]); },
            print => sub { print $_[2] or die $!; },
             debug => sub { }, # like print; msgs contain trailing \n
@@ -419,6 +423,7 @@ sub new_verifier {
     }
     bless $verifier, $class;
     $verifier->_dbopen();
+    $verifier->_ch('srcdump_prepare');
     return $verifier;
 }
 
@@ -979,7 +984,7 @@ sub check_ok ($) {
     my $cookie = $r->construct_cookie($cookiesecret);
 
     if ($kind =~ m/^SRCDUMP-(\w+)$/) {
-       $r->_ch('srcdump_dump_thing', (lc $1));
+       $r->_ch('srcdump_dump', (lc $1));
        return 0;
     }