← Back to branch summary

~ubuntu-branches/ubuntu/trusty/mirmon/trusty-proposed

« back to all changes in this revision

Viewing changes to probe

  • Committer: Bazaar Package Importer
  • Author(s): Hideki Yamane
  • Date: 2011-01-31 23:04:50 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20110131230450-dzo153mq0bmwsj70
Tags: 2.4-1
* New upstream release
  - now the code is modularised, see RELEASE-NOTES file
* debian/patches
  - deal with upstream change, once remove all patches
  - recreate trace-UTC_timestamps
* debian/mirmon.install
  - add probe, Mirmon.pm, mirmon.pl
* debian/docs
  - add RELEASE-NOTES
* debian/{rules,mirmon.1}
  - remove related stuff since upstream now includes mirmon.1
* debian/mirmon.manpages
  - use upstream manpage file
* debian/postrm
  - remove mirror state in purge only

Show diffs side-by-side

added added

removed removed

Lines of Context:
probe
 
1
#! /usr/bin/perl -w
 
2
 
 
3
use strict ;
 
4
 
 
5
my $WGET  = '/usr/bin/wget' ;
 
6
my $RSYNC = '/usr/bin/rsync' ;
 
7
 
 
8
my $timeout = 300 ;
 
9
my $tmp_dir = '/tmp/mirmon' ;
 
10
 
 
11
my $prog = substr($0,rindex($0,'/')+1) ;
 
12
my $Usage = <<USAGE ;
 
13
Usage: $prog [-v] [-q] [-d] [-t timeout] url
 
14
option v : be verbose
 
15
option q : be quiet
 
16
option d : show debug info
 
17
option t : timeout in seconds (default $timeout)
 
18
argument url :
 
19
  rsync://host.dom.com/module/file
 
20
   http://host.dom.com/some/file
 
21
    ftp://host.dom.com/some/file
 
22
USAGE
 
23
sub Usage { die "$_[0]$Usage" ; }
 
24
sub Error { die "$prog: $_[0]\n" ; }
 
25
sub Warn  { warn "$prog: $_[0]\n" ; }
 
26
 
 
27
# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
 
28
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
 
29
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
 
30
# ID  = perl identifier
 
31
# SPC = i|f|s for integer, fixedpoint real or string argument
 
32
 
 
33
use Getopt::Long ;
 
34
Getopt::Long::config('no_ignore_case') ;
 
35
my %opt = () ; Usage('') unless GetOptions
 
36
  ( \%opt, qw(v q d t=i) ) ;
 
37
Usage("Arg count\n") unless @ARGV == 1 ;
 
38
 
 
39
my $url = shift ;
 
40
$timeout = $opt{t} if exists $opt{t} ;
 
41
$opt{v} ||= $opt{d} ;
 
42
 
 
43
my $opt_v = '' ; $opt_v = '-v' if $opt{v} ;
 
44
my $opt_q = '' ; $opt_q = '-q' if $opt{q} ;
 
45
 
 
46
# make a tmp dir for rsync
 
47
 
 
48
-d $tmp_dir or mkdir $tmp_dir or Error "can't mkdir $tmp_dir ($!)" ;
 
49
 
 
50
# handle rsync urls with rsync
 
51
#  rewrite rysnc://host.dom.com/module/file -> host.dom.com::module/file
 
52
# handle ftp/http urls with wget
 
53
 
 
54
if ( $url =~ m!^rsync://(.*)$! )
 
55
  { my $src = $1 ;
 
56
    my $dst = $src ;
 
57
    $dst =~ s![/\s]!_!g ;
 
58
    my $TMP = "$tmp_dir/$dst" ;
 
59
    $src =~ s!/!::! ;
 
60
    unlink $TMP ; # ignore status
 
61
    my $cmd = "$RSYNC $opt_v $opt_q --no-motd --timeout $timeout $src $TMP" ;
 
62
    Warn sprintf "'%s'\n", $cmd if $opt{d} ;
 
63
    system $cmd ;
 
64
    if ( open TMP, $TMP )
 
65
      { print <TMP> ; close TMP ; }
 
66
    else
 
67
      { Warn "can't open $TMP" ; }
 
68
  }
 
69
else
 
70
  { my $cmd = "$WGET -O - $opt_v $opt_q -t 1 -T $timeout $url |" ;
 
71
    Warn sprintf "'%s'\n", $cmd if $opt{d} ;
 
72
    if ( open CMD, $cmd )
 
73
      { print <CMD> ; close CMD ; }
 
74
    else
 
75
      { Warn "can't popen $cmd ($!)" ; }
 
76
  }