File: common.pm

package info (click to toggle)
libnet-sftp-foreign-perl 1.57%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 552 kB
  • ctags: 362
  • sloc: perl: 4,790; sh: 48; makefile: 2
file content (107 lines) | stat: -rw-r--r-- 2,249 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
use strict;
use warnings;

use File::Spec;
use Test::More;

select STDERR;
$|=1;
select STDOUT;

$ENV{PATH} = '/usr/bin:/bin' if ${^TAINT};

sub is_windows { $^O =~ /MSWin32/i }

sub sftp_server {

    my ($sscmd, @ssh, $ssname);

    if(is_windows) {
	$ssname = 'sftp-server.exe';
	my $pf;
	eval {
	    require Win32;
	    $pf = Win32::GetFolderPath(Win32::CSIDL_PROGRAM_FILES());
	};
	$pf = "C:/Program Files/" unless defined $pf;
	
	@ssh = ("$pf/openssh/bin/ssh.exe",
		"$pf/openssh/usr/bin/ssh.exe",
		"$pf/bin/ssh.exe",
		"$pf/usr/bin/ssh.exe");
    }
    else {
	$ssname = 'sftp-server';
	@ssh = qw( /usr/bin/ssh
		   /usr/local/bin/ssh
		   /usr/local/openssh/bin/ssh
		   /opt/openssh/bin/ssh
                   /opt/ssh/bin/ssh );
    }

    if (eval {require File::Which; 1}) {
	unshift @ssh, File::Which::where('ssh');
    }
    elsif ($^O !~ /MSWin32/i) {
	chomp(my $ssh = `which ssh`);
	unshift @ssh, $ssh if (!$? and $ssh);
    }

 SEARCH: for (@ssh) {
	my ($vol, $dir) = File::Spec->splitpath($_);
	
	my $up = File::Spec->rel2abs(File::Spec->catpath($vol, $dir, File::Spec->updir));
	
	for ( File::Spec->catfile($vol, $dir, $ssname),
	      File::Spec->catfile($up, 'lib', $ssname),
	      File::Spec->catfile($up, 'libexec', $ssname),
	      File::Spec->catfile($up, 'sbin', $ssname),
	      File::Spec->catfile($up, 'lib', 'openssh', $ssname),
	      File::Spec->catfile($up, 'usr', 'lib', $ssname),
	      File::Spec->catfile($up, 'usr', 'libexec', $ssname),
	      File::Spec->catfile($up, 'usr', 'sbin', $ssname) ) {

	    if (-x $_) {
		$sscmd = $_;
		diag "sftp-server found at $_\n";
		last SEARCH;
	    }
	}
    }

    return $sscmd;
}

sub filediff {
    my ($a, $b) = @_;
    open my $fa, "<", $a
	or die "unable to open file $a";

    open my $fb, "<", $b
	or die "unable to open file $b";

    binmode $fa;
    binmode $fb;

    while (1) {
	my $la = read($fa, my $da, 2048);
	my $lb = read($fb, my $db, 2048);
	
	return 1 unless (defined $la and defined $lb);
	return 1 if $la != $lb;
	return 0 if $la == 0;
	return 1 if $la ne $lb;
    }
}

sub mktestfile {
    my ($fn, $count, $data) = @_;

    open DL, '>', $fn
	or die "unable to create test data file $fn";

    print DL $data for (1..$count);
    close DL;
}

1;