downloader: make cgi-script functional and add documentation

Signed-off-by: Robert C. Helling <helling@atdotde.de>

1 files changed, 143 insertions, 12 deletions

diff --git a/scripts/downloader.pl b/scripts/downloader.pl
index d41854658..b15528229 100644
--- a/scripts/downloader.pl
+++ b/scripts/downloader.pl
@@ -1,6 +1,21 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w
+
+use strict;
 
 use CGI;
+use Git::Repository;
+
+# File to store cloud credentials
+my $config_file = "/opt/ssrf/ssrf.conf";
+# Where to store the git repository
+my $git_dir = "/opt/ssrf/gitdir";
+# Downloader binary
+my $downloader = "/home/pi/src/subsurface/build/subsurface-downloader";
+
+my %conf;
+
+# Use unbuffered output
+$| = 1;
 
 my $q = CGI->new;
 
@@ -8,32 +23,129 @@ print $q->header('text/html');
 print $q->img({src => 'https://subsurface-divelog.org/wp-content/uploads/2015/10/subsurface-icon1.png'});
 print $q->h1("Subsurface");
 
+printf "Reading config file $config_file\n";
+open CONF, $config_file || die "Cannot read $config_file:$!";
+while (<CONF>) {
+  if (/^\s*(\w+)\s*=\s*(\w.*)$/) {
+    $conf{$1} = $2;
+  }
+}
+close CONF;
+
 my %dcs;
 &load_supported_dcs;
 
 print $q->start_form();
-if ($q->param("Manufacturer")) {
+
+my $action = $q->param("action");
+
+if ($action eq "config") {
+
+  # Enter cloud credentials
+
+  print "Subsurface cloud user name (typically your email address): ", $q->textfield(-name => 'username', -default => $conf{username});
+  print "<br>Subsurface cloud password: ", $q->password_field(-name => "password");
+  &next_action("writeconfig");
+
+} elsif ($action eq "writeconfig") {
+
+  $conf{username} = $q->param("username");
+  $conf{username} =~ s/\s//g;
+  $conf{password} = $q->param("password");
+  $conf{password} =~ s/\s//g;
+  &write_conf;
+  &next_action("start");
+
+} elsif ($action eq "setmanufacturer") {
+
+  # Now we know the manufacturer, ask for model
+
   print $q->hidden(-name => "Manufacturer", -default => $q->param("Manufacturer"));
-  if ($q->param("Product")) {
-    print $q->hidden(-name => "Product", -default => $q->param("Product"));
-    opendir DIR, "/dev";
-    my @devices = map {"/dev/$_"} (grep {!/^\./} (readdir DIR));
-    closedir DIR;
-    print "Select mount point:";
-    print $q->popup_menu("Mount point", \@devices);
+  print "Select ",$q->param("Manufacturer")," model:";
+  print $q->popup_menu("Product", $dcs{$q->param("Manufacturer")});
+  &next_action("setproduct")
+    
+} elsif ($action eq "setproduct") {
+
+  # Now we know the model as well, ask for mount point
+
+  print $q->hidden(-name => "Manufacturer", -default => $q->param("Manufacturer"));
+  print $q->hidden(-name => "Product", -default => $q->param("Product"));
+
+  opendir DIR, "/dev";
+  my @devices = map {"/dev/$_"} (grep {!/^\./} (readdir DIR));
+  closedir DIR;
+  print "Select mount point:";
+  print $q->popup_menu(-name => "Mount point", -values => \@devices);
+  &next_action("startdownload");
+
+} elsif ($action eq "startdownload") {
+
+  # Do the actual download
+
+  my $repo;
+
+  # Does the repo exist?
+
+  if (-d $git_dir) {
+
+    # ... yes, pull latest version
+
+    $repo = Git::Repository->new( work_tree => $git_dir);
+    print "Pulling latest version from cloud.";
+    print $q->pre($repo->run("pull"));
   } else {
-    print "Select ",$q->param("Manufacturer")," model:";
-    print $q->popup_menu("Product", $dcs{$q->param("Manufacturer")});
+
+    # ... no, clone it
+
+    my $en_username = $conf{username};
+
+    # We need to escape the @ in the username to be able to encode it in the URL.
+    # Note: If we fail, the password gets written to /var/log/apache/error.log,
+    # Maybe there is a better way to pass the password to git...
+    
+    $en_username =~ s/\@/%40/g;
+    my $git_url = 'https://' . $en_username . ':' . $conf{password} . '@cloud.subsurface-divelog.org//git/' . $conf{username};
+    print "Cloning repository";
+    print $q->pre(Git::Repository->run( clone => $git_url, $git_dir));
+    $repo = Git::Repository->new( work_tree => $git_dir );
   }
+
+  # Assemble the command with all arguments
+  
+  my $command = "$downloader --dc-vendor=" . $q->param('Manufacturer') .
+		" --dc-product=" . $q->param('Product') .
+		" --device=" . $q->param("Mount point") .
+		' ' . $git_dir .
+		'/[' . $conf{username} . ']';
+  print $q->pre($command);
+
+  # ... and run it
+  
+  print $q->pre(`$command`);
+
+  # Push back to the cloud
+  
+  print "Checkout user branch";
+  print $q->pre($repo->run("checkout", $conf{username}));
+  print "Push changes to cloud";
+  print $q->pre($repo->run("push", "origin", $conf{username}));
+  &next_action("start");
 } else {
+
+  # This is the mode we start up in
+  
   print "Select dive computer manufacturer:";
   print $q->popup_menu("Manufacturer", [sort keys %dcs]);
+  &next_action("setmanufacturer")
 }
 
-print $q->submit();
 
+print $q->br(),$q->submit(-name => "  OK  ");
 print $q->end_form();
 
+print $q->br(), $q->a({-href => $q->url() . "?action=config"}, "Configure cloud credentials");
+
 sub load_supported_dcs {
   open IN, "/home/pi/src/subsurface/build/subsurface-downloader --list-dc|";
   
@@ -51,3 +163,22 @@ sub load_supported_dcs {
   close IN;
 }
 
+
+sub write_conf {
+  print "Writing config file\n";
+  open CONFW, ">$config_file" || die "Cannot write $config_file:$!";
+  foreach my $key (keys %conf) {
+    print CONFW "$key = $conf{$key}\n";
+  }
+  close CONFW;
+  print "Done\n";
+}
+
+sub next_action {
+  my $next = shift;
+  $q->param(action => $next);
+  print $q->hidden(
+		   -name => "action",
+		   -value => $next);
+  return;
+}