From 457b20bce7642092238911c7a184075c2e02643d Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 16:49:46 +0100
Subject: [PATCH 1/8] Util: Support "include" in configuration

An example of how to use this will come in a moment.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 Util.pm | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/Util.pm b/Util.pm
index c292a1a..ebf4712 100644
--- a/Util.pm
+++ b/Util.pm
@@ -391,11 +391,22 @@ sub LDAPUpdate {
 ###################
 # Config file stuff
 sub ReadConfigFile {
+  our %config = { };
+  &ReadSomeConfigFile($configfile, \%config);
+  return %config;
+}
+
+sub ReadSomeConfigFile {
   # reads a config file and results a hashref with the results
-  my (%config, $attr, $setting);
-  open (F, "<$configfile") || &HTMLError("Cannot open $configfile: $!");
-  while (<F>) {
+  my ($file, $config) = @_;
+  my ($attr, $setting);
+  my $fh = new IO::File $file, '<' || &HTMLError("Cannot open config file $file: $!");
+  while (<$fh>) {
     chomp;
+    if (s{^include\s+(?!=)}{}) {
+      &ReadSomeConfigFile($_, $config);
+      next;
+    }
     if ((!/^\s*#/) && ($_ ne "")) {
       # Chop off any trailing comments
       s/#.*//;
@@ -405,11 +416,10 @@ sub ReadConfigFile {
       $setting =~ s/;$//;
       $attr =~ s/^\s+//; $attr =~ s/\s+$//;
       $setting =~ s/^\s+//; $setting =~ s/\s+$//;      
-      $config{$attr} = $setting;
+      $config->{$attr} = $setting;
     }
   }
-  close F;
-  return %config;
+  close $fh;
 }
 
 sub UpgradeConnection($) {
-- 
GitLab


From 7a440c0be0a979fe181f018911ec23d9eac8c505 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 16:50:18 +0100
Subject: [PATCH 2/8] Util: Honour USERDIR_LDAP_CONF env var

If this is set, read that as our config, rather than the hardcoded
file in /etc.  This will make it possible to test this code from a
clean git tree.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 Util.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Util.pm b/Util.pm
index ebf4712..6edee15 100644
--- a/Util.pm
+++ b/Util.pm
@@ -13,7 +13,7 @@ use Crypt::CBC;
 use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
 
 my $blocksize = 8; # A blowfish block is 8 bytes
-my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
+my $configfile = $ENV{USERDIR_LDAP_CONF} // "/etc/userdir-ldap/userdir-ldap.conf";
 #my $configfile = "/home/randolph/html/debian/perl/userdir-ldap.conf";
 
 my %config = &ReadConfigFile;
-- 
GitLab


From bfdd89b7f2599a1b5161443a581f40094a205032 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 16:51:01 +0100
Subject: [PATCH 3/8] test-debian.conf: Recipe for testing this code from a
 clean tree.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 test-debian.conf | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)
 create mode 100644 test-debian.conf

diff --git a/test-debian.conf b/test-debian.conf
new file mode 100644
index 0000000..5a871b9
--- /dev/null
+++ b/test-debian.conf
@@ -0,0 +1,17 @@
+# Testing config file for ldap scripts
+
+# For testing in a chroot on (say) a porterbox,
+#    apt-get install libcgi-pm-perl libdate-manip-perl libnet-ldap-perl
+#                    libcrypt-cbc-perllibdigest-hmac-perl w3m
+# Copy
+#     master.debian.org:/etc/userdir-ldap/userdir-ldap.conf
+# into your "..".
+#
+# Then
+#    USERDIR_LDAP_CONF=test-debian.conf REQUEST_METHOD=GET \
+#    QUERY_STRING='host=amdahl' ./machines.cgi >t.html && w3m ./t.html
+
+include ../userdir-ldap.conf
+
+templatesdir = "html";
+hosthtml = "html/hostinfo.wml";
-- 
GitLab


From 3f21bb5523fa19c2bfbd31eb486f77f816cf2ccc Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 17:21:20 +0100
Subject: [PATCH 4/8] machines.cgi: Refactor hidden filter code

We are going to want to put something else under this same condition
in a moment.

No functional change.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 machines.cgi | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/machines.cgi b/machines.cgi
index ce18f0f..e9a08ae 100755
--- a/machines.cgi
+++ b/machines.cgi
@@ -166,7 +166,9 @@ foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]}
     $selected = " selected ";
   }
 
-  $hostlist .= "<option value=\"$thishost\"$selected>$thishost\n" unless ($data->{status}->[0] =~ /^unlisted/);
+  unless ($data->{status}->[0] =~ /^unlisted/) {
+    $hostlist .= "<option value=\"$thishost\"$selected>$thishost\n";
+  }
 
   # collect summary info
   foreach $key (keys(%summaryattrs)) {
-- 
GitLab


From 5179aa262a3a512bc67a0d0c30b108c244ad9d63 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 17:22:01 +0100
Subject: [PATCH 5/8] machines.cgi: Honour "purpose_search" form parameter

This is compared (literally) with the purpose values in LDAP.

Currently there is nothing in the form to cause this to be sent, but
URLs like
   machines.cgi?purpose_search=porterbox
will now work.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 machines.cgi | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/machines.cgi b/machines.cgi
index e9a08ae..36d34ad 100755
--- a/machines.cgi
+++ b/machines.cgi
@@ -108,6 +108,7 @@ my $query = new CGI;
 my $host = lc($query->param('host'));
 my $sortby = lc($query->param('sortby')) || "host";
 my $sortorder = lc($query->param('sortorder')) || "asc";
+my $purpose_search = lc($query->param('purpose_search') || '');
 
 
 &Util::HTMLSendHeader;
@@ -170,6 +171,8 @@ foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]}
     $hostlist .= "<option value=\"$thishost\"$selected>$thishost\n";
   }
 
+  next if length($purpose_search) && !grep { $purpose_search eq $_ } @{ $data->{purpose} };
+
   # collect summary info
   foreach $key (keys(%summaryattrs)) {
     if (exists $summarylistitems{$key}) {
-- 
GitLab


From 57ec2772c321c9963d375e23093e5316e8105b86 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 17:23:55 +0100
Subject: [PATCH 6/8] machines.cgi: Provide "purpose_search" dropdown

We only support, here, a subset of the possible purposes.

This serves both to avoid html escaping and also to limit the size of
the drop down (which otherwise contains a lot of singleton purposes).

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 html/hostinfo.wml |  4 ++++
 machines.cgi      | 14 ++++++++++++++
 2 files changed, 18 insertions(+)

diff --git a/html/hostinfo.wml b/html/hostinfo.wml
index 796df4b..a896b06 100644
--- a/html/hostinfo.wml
+++ b/html/hostinfo.wml
@@ -6,6 +6,10 @@
 <option value="_summary_">Summary
 ~hostlist~
 </select>
+<select name=purpose_search>
+<option value="">Regardless of purpose
+~purposelist~
+</select>
 <input type=submit value="Go">
 </form>
 <hr>
diff --git a/machines.cgi b/machines.cgi
index 36d34ad..7c948ba 100755
--- a/machines.cgi
+++ b/machines.cgi
@@ -121,6 +121,8 @@ $mesg = $ldap->search(base  => $config{hostbasedn}, filter => 'host=*');
 $mesg->code && &Util::HTMLError($mesg->error);
 $entries = $mesg->as_struct;
 
+our %purposes;
+
 foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]} keys(%$entries)) {
   $data = $entries->{$dn};
 
@@ -169,6 +171,7 @@ foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]}
 
   unless ($data->{status}->[0] =~ /^unlisted/) {
     $hostlist .= "<option value=\"$thishost\"$selected>$thishost\n";
+    $purposes{$_} = 1 foreach @{ $data->{purpose} };
   }
 
   next if length($purpose_search) && !grep { $purpose_search eq $_ } @{ $data->{purpose} };
@@ -190,6 +193,16 @@ foreach $dn (sort {$entries->{$a}->{host}->[0] cmp $entries->{$b}->{host}->[0]}
 }
 $ldap->unbind;
 
+our $purposelist;
+foreach my $p (sort keys %purposes) {
+  next if $p =~ m{[^-+_() 0-9a-z]}i;
+  my $selected = ($purpose_search eq $p) && ' selected';
+  # ^ This adhoc rule serves to suppress purposes that are discursive and shouldn't appear in the dropdown
+  #   They could still be searched for by sending the string precisely.  Note tyhat if this regexp is
+  #   significantly relaxed, html/url quoting would have to be considered!
+  $purposelist .= "<option value=\"$p\"$selected>$p\n";
+}
+
 if ($output{havehostdata}) {
   $hostdetails = "<h1>Information about $output{hostname}</h1>\n";
   $hostdetails .= "<ul>\n";
@@ -238,6 +251,7 @@ open (F, "<$config{hosthtml}") || &Util::HTMLError("Cannot open host template");
 while (<F>) {
   s/~hostlist~/$hostlist/;
   s/~hostdetails~/$hostdetails/;
+  s/~purposelist~/$purposelist/;
   print;
 }
 close F;
-- 
GitLab


From 74624b2336be602e06a998dd3e5f7edfcd55d1c3 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 17:48:17 +0100
Subject: [PATCH 7/8] machines.cgi: Provide porterbox and buildd convenience
 buttons

ISTM that these are what most people will be looking for most of the
time.  It's probably worth making a fast path for them.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 html/hostinfo.wml | 4 ++++
 machines.cgi      | 9 ++++++++-
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/html/hostinfo.wml b/html/hostinfo.wml
index a896b06..324dc84 100644
--- a/html/hostinfo.wml
+++ b/html/hostinfo.wml
@@ -12,6 +12,10 @@
 </select>
 <input type=submit value="Go">
 </form>
+<b>Show only:</b>
+<form method="post" action="machines.cgi">
+~purposes_conveniencebuttons~
+</form>
 <hr>
 ~hostdetails~
 <br>
diff --git a/machines.cgi b/machines.cgi
index 7c948ba..474da86 100755
--- a/machines.cgi
+++ b/machines.cgi
@@ -47,6 +47,8 @@ my (%attrs, @attrorder, %summaryattrs, @summaryorder, %summarylistitems);
 	        disk bandwidth status notes sshrsahostkey sshrsahostfprint
 		description purpose);
 
+our @purposes_conveniencebuttons = qw(porterbox buildd);
+
 # ditto for summary
 %summaryattrs = ('hostname' => 'Host name',
 		 'host'     => 'just for a link',
@@ -110,7 +112,6 @@ my $sortby = lc($query->param('sortby')) || "host";
 my $sortorder = lc($query->param('sortorder')) || "asc";
 my $purpose_search = lc($query->param('purpose_search') || '');
 
-
 &Util::HTMLSendHeader;
 $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
 &Util::UpgradeConnection($ldap) unless $config{usessl} eq 'False';
@@ -203,6 +204,11 @@ foreach my $p (sort keys %purposes) {
   $purposelist .= "<option value=\"$p\"$selected>$p\n";
 }
 
+our $purposes_conveniencebuttons;
+foreach my $p (@purposes_conveniencebuttons) {
+  $purposes_conveniencebuttons .= "<input type=\"submit\" name=\"purpose_search\" value=\"$p\">";
+}
+
 if ($output{havehostdata}) {
   $hostdetails = "<h1>Information about $output{hostname}</h1>\n";
   $hostdetails .= "<ul>\n";
@@ -252,6 +258,7 @@ while (<F>) {
   s/~hostlist~/$hostlist/;
   s/~hostdetails~/$hostdetails/;
   s/~purposelist~/$purposelist/;
+  s/~purposes_conveniencebuttons~/$purposes_conveniencebuttons/;
   print;
 }
 close F;
-- 
GitLab


From f862512c1c06d92b1504e747e45d09034a7e09c9 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Thu, 21 May 2020 17:53:23 +0100
Subject: [PATCH 8/8] machines.cgi: Convenience buttons sort by architecture

This makes these lists directly useable.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 html/hostinfo.wml | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/html/hostinfo.wml b/html/hostinfo.wml
index 324dc84..7031f3a 100644
--- a/html/hostinfo.wml
+++ b/html/hostinfo.wml
@@ -14,6 +14,8 @@
 </form>
 <b>Show only:</b>
 <form method="post" action="machines.cgi">
+<input type=hidden name="sortby" value="architecture">
+<input type=hidden name="sortorder" value="asc">
 ~purposes_conveniencebuttons~
 </form>
 <hr>
-- 
GitLab