mirmon: start refactor of probe

Signed-off-by: Robin H. Johnson <robbat2@gentoo.org>

1 files changed, 75 insertions, 0 deletions

diff --git a/probe-mirmon b/probe-mirmon
new file mode 100755
index 0000000..7b57923
--- /dev/null
+++ b/probe-mirmon
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+# $Id: probe-mirmon,v 1.4 2009/08/19 23:15:46 karl Exp $
+# public domain.  Originally written by Karl Berry, 2009.
+#
+# Probe rsync url's for mirmon; use wget for anything else.
+# From description at http://people.cs.uu.nl/henkp/mirmon.
+#
+# Also requires a patch to mirmon itself to accept rsync urls
+# (and I wanted https too):
+# --- /usr/local/share/mirmon/ORIG/mirmon	2007-08-18 18:05:47.000000000 +0200
+# +++ /usr/local/share/mirmon/mirmon	2009-07-03 22:38:00.000000000 +0200
+# @@ -386,3 +386,3 @@
+#      my ( $type, $site, $home ) ;
+# -    if ( $url =~ m!^(ftp|http)://([^/:]+)(:\d+)?/! )
+# +    if ( $url =~ m!^(ftp|https?|rsync)://([^/:]+)(:\d+)?/! )
+#        { $type = $1 ; $site = $2 ; $home = $& ; }
+
+main(@ARGV);
+
+use Date::Parse (); # dev-perl/TimeDate
+use File::Tempdir;  # dev-perl/File-Tempdir
+
+sub main {
+  my ( $timeout, $url ) = @_;
+  if ( $url =~ m,^rsync://, ) {
+    handle_rsync( $timeout, $url );
+  }
+  else {
+    handle_wget( $timeout, $url );
+  }
+}
+
+sub handle_wget {
+  my ( $timeout, $url ) = @_;
+  # TODO: replace this with native HTTP
+  # TODO: munge the output!
+  exec {'/usr/bin/wget'} 'wget', qw( -q --passive-ftp -O - -T ), $timeout, '-t', 1, $url;
+}
+
+sub handle_rsync {
+  my ( $timeout, $url ) = @_;
+
+  my $tmpdir = File::Tempdir->new();
+  my $dir    = $tmpdir->name;
+  my $file   = $url;
+
+  $file =~ s/\W/_/g;    # translate all non-letters to _
+
+  if ( my $fail = system '/usr/bin/rsync', qw( --no-motd --timeout ), $timeout, $url, "$dir/$file" ) {
+    warn "rsync failed, exit code $fail, $! $? $@\n";
+    exit $fail;
+  }
+
+  open my $fh, '<', "$dir/$file" or do {
+    warn "Opening Downloaded timestamp Failed";
+    exit 900;                         # rediculous exit code.
+  };
+
+  print munge_date(<fh>);
+  exit 0;
+
+}
+
+sub munge_date {
+	my $timestr = $_;
+	my $timestamp = int($timestr);
+	my $year2020 = 1577836800;
+	my $year2038 = 2145916800;
+	# If the string starts with an epoch, just use that
+	if($int_timestamp >= $year2020 && $int_timestamp <= $year2038) {
+		return $int_timestamp;
+	} else {
+		return Date::Parse::str2time($timestr);
+	}
+}