From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Mon, 18 Feb 2013 15:27:25 +0000 (+0000)
Subject: automatic agpl compliance: wip, before rationalise locations and dirs
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=cgi-auth-flexible.git;a=commitdiff_plain;h=8f2a5fab109a38c7ad841637fab0859eae7beb5f;hp=835fb7c01a795a36ff8a24daa8e3896c208dcca3

automatic agpl compliance: wip, before rationalise locations and dirs
---

diff --git a/cgi-auth-flexible.pm b/cgi-auth-flexible.pm
index 0662563..2be63b4 100644
--- a/cgi-auth-flexible.pm
+++ b/cgi-auth-flexible.pm
@@ -47,6 +47,7 @@ use Digest;
 use Digest::HMAC;
 use Digest::SHA;
 use Data::Dumper;
+use File::Copy;
 
 #---------- public utilities ----------
 
@@ -197,6 +198,29 @@ sub gen_plain_footer_html ($$) {
 	    '</address>');
 }
 
+#---------- licence and source code ----------
+
+sub dump_licence ($$$) {
+    
+    my ($c,$r, $fh) = @_;
+    foreach my $incdir ($r->_ch('getsource_includedirs')) {
+	
+    }
+}
+
+sub source_dump_get_path ($$$) {
+    my ($c,$r, $thing) = @_;
+    die if $thing =~ m/\W/;
+    my $pat = $r->{S}('source_dump_path_pat');
+    my $leaf = sprintf $pat, $thing;
+    return $r->_absify_path($leaf);
+}
+
+sub source_dump_thing ($$$) {
+    my ($c,$r, $thing, $outfn) = @_;
+    my $path = $r->_ch('source_dump_get_path', $thing);
+    copy($path, $utfn
+
 #---------- verifier object methods ----------
 
 sub new_verifier {
@@ -207,6 +231,8 @@ sub new_verifier {
 	    assocdb_dbh => undef, # must have AutoCommit=0, RaiseError=1
 	    assocdb_path => 'caf-assocs.db',
 	    keys_path => 'caf-keys',
+	    source_dump_path_pat => 'caf-%s.dump',
+	    source_dump_get_path => \&source_dump_get_path,
 	    assocdb_dsn => undef,
 	    assocdb_user => '',
 	    assocdb_password => '',
@@ -253,6 +279,8 @@ sub new_verifier {
 	    gen_login_form => \&gen_plain_login_form,
 	    gen_login_link => \&gen_plain_login_link,
 	    gen_postmainpage_form => \&gen_postmainpage_form,
+	    source_dump_thing => \&source_dump_thing,
+	    source_includedirs => sub { grep { !m#^/etc/# } @INC; },
 	    gettext => sub { gettext($_[2]); },
 	    print => sub { print $_[2] or die $!; },
             debug => sub { }, # like print; msgs contain trailing \n
@@ -395,8 +423,13 @@ sub _debug ($@) {
 sub _get_path ($$) {
     my ($v,$keybase) = @_;
     my $leaf = $v->{S}{"${keybase}_path"};
-    my $dir = $v->{S}{dir};
+    return $r->_absify_path($leaf);
+}
+
+sub _absify_path ($$) {
+    my ($v,$leaf) = @_;
     return $leaf if $leaf =~ m,^/,;
+    my $dir = $v->{S}{dir};
     die "relying on cwd by default ?!  set dir" unless defined $dir;
     return "$dir/$leaf";
 }
@@ -820,6 +853,11 @@ sub check_ok ($) {
     my $params = $divert->{Params};
     my $cookie = $r->construct_cookie($cookiesecret);
 
+    if ($kind =~ m/^SPECIAL-(LICENCE|SOURCE)$/) {
+	$r->_ch('dump_'.lc $1, \*STDOUT);
+	return 0;
+    }
+
     if ($kind =~ m/^REDIRECT-/) {
 	# for redirects, we honour stored NextParams and SetCookie,
 	# as we would for non-divert