Path: sranha!katsu From: katsu@sra.co.jp (WATANABE Katsuhiro) Message-ID: Date: 23 Apr 91 17:37:52 Organization: Software Research Associates, Inc.,Japan Newsgroups: sra.test Subject: recursive get with FTP Distribution: sra  FTP でファイル群を get する時に、rf という下に示すような perl のスクリプトを使うのは有用かどうかを問いてみるテスト。 gcc のバイナリを anonymous ftp でコピーしようとしたら、 include ファイルが沢山のディレクトリに分かれていて面倒な思いをしました。 mh のバイナリを anonymous ftp でコピーしようとしたら、 link ははられてるわ、symlink はあるわ、モードや suid ビットや uid がいじられてるわで、これまた面倒な思いをしました。  以上の経験から、遠隔の機械に anonymous ftp した後、rcp -r のような 感じで再帰的に get して、link や symlink や mode や uid/gid を 適当に設定してくれるようなコマンドを作ってみました。 (もちろん root じゃないと uid/gid の設定は失敗します)  使い方ですが、第一引数に相手側ホストを、第二引数以下に get したい ファイルやディレクトリの遠隔側でのパスを指定して下さい。 rf sranha msdos/tools /arch/comp.sources.x/list とかやると、(これは説明のための例なので、いきなり試さないほうがいいです) rsh sranha -l ftp "cd msdos; tar -cf - tools" | tar -xf - ;¥ rsh sranha -l ftp "cd /arch/comp.sources.x; tar -cf - list" | tar -xf - とやったのとほぼ同じ結果が得られます。もちろん anonymous ftp で入りますから rsh が実行できる必要はありません。パスワードには「ログイン名@ホスト名」を 使います。  rf -d ... とかやると、実際に何をやってるのかを少し見せます。 rf -c "I want to get mh6.7" ... とかやると、パスワードに 「katsu@sran14 (I want to get mh6.7)」のようなコメント付きのものを 使うようになります。 rf -l katsu ... とかやると、デフォルトのユーザー名 ftp の代わりに、 katsu を使うようになります。  会話する部分がないので、夜中に大きなファイルを get するように 密かに at で仕組んでおくというのにも使えるかも知れません。  動かしてみた人がいたら、短くていいですから「動いた」「動かなかった」と メールください。 > From: merlyn@iwarp.intel.com (Randal L. Schwartz) > Newsgroups: comp.lang.perl > Subject: better version of chat2.pl > Message-ID: <1991Apr11.222343.28800@iwarp.intel.com> という、疑似端末を起こして他のプロセスと会話するパッケージを 中に含んでいます。 #!/usr/local/bin/perl #!/usr/local/bin/perl -*- perl -*- # # ftp front end to recursive get. # (I call this as 'rf',but it's uninteresting name.) # by katsu@sra.co.jp 1991/Apr/23 # # Gets directries recursively. # Makes symbolic links for ones on remote. # Makes (hard)links for files those have identical inode on remote. # Sets mode, owner and group same as those of remote. # # example) # rf sranha msdos/tools /arch/comp.sources.x/list # means ..... # rcp -r sranha:‾ftp/msdos/tools . ;¥ # rcp -r sranha:‾ftp/arch/comp.sources.x/list . # # $Header: /public/usr/mmb/katsu/hack/perl/rftp/rf,v 0.1 91/04/23 16:42:47 katsu Exp Locker: katsu $ # $version = "0"; $login = "ftp"; chop($password = getlogin."@".`hostname`); $ftpprompt = 'ftp> $'; $to_soon = 5; # timeout for local operations $to_remotecmd = 20; # timeout for easy commands on remote $to_filex = 60 * 60; # timeout for file transfers $nobodyuid = 65534; # used when cannot identify uid of a owner require 'getopts.pl'; # -d debug (force -v) # -v verbose # -c commens insert a comment after password # -l name login name &Getopts('c:l:dv'); unless (defined($remote = shift(@ARGV))) { local($_, $name) = &splitpath($0); print STDERR "Front end of FTP getting (Ver $version)¥n"; print STDERR "Usage: $name [-d] [-v] [-l loginname] [-c comment] remotehost [file ...]¥n"; exit(1); } if ($opt_d) {$opt_v = 1;} if ($opt_c) {$password .= "($opt_c)";} if ($opt_l) {$login = $opt_l;} #require 'chat2.pl'; # because it's not a standard package and it's alpha release, # include it here directry in this file. # From: merlyn@iwarp.intel.com (Randal L. Schwartz) # Newsgroups: comp.lang.perl # Subject: better version of chat2.pl # Message-ID: <1991Apr11.222343.28800@iwarp.intel.com> # Date: 11 Apr 91 22:23:43 GMT # Reply-To: merlyn@iwarp.intel.com (Randal L. Schwartz) # Organization: Stonehenge; netaccess via Intel, Beaverton, Oregon, USA ## chat.pl: chat with a server ## V2.01.alpha.2 91/04/10 ## Randal L. Schwartz package chat; $sockaddr = 'S n a4 x8'; chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4]; $thisproc = pack($sockaddr, 2, 0, $thisaddr); # *S = symbol for current I/O, gets assigned *chatsymbol.... $next = "chatsymbol000000"; # next one $nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++ ## $handle = &chat'open_port("server.address",$port_number); ## opens a named or numbered TCP server sub open_port { ## public local($server, $port) = @_; local($serveraddr,$serverproc); *S = ++$next; if ($server =‾ /^(¥d+)+¥.(¥d+)¥.(¥d+)¥.(¥d+)$/) { $serveraddr = pack('C4', $1, $2, $3, $4); } else { local(@x) = gethostbyname($server); return undef unless @x; $serveraddr = $x[4]; } $serverproc = pack($sockaddr, 2, $port, $serveraddr); unless (socket(S, 2, 1, 6)) { # XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp' # but who the heck would change these anyway? (:-) ($!) = ($!, close(S)); # close S while saving $! return undef; } unless (bind(S, $thisproc)) { ($!) = ($!, close(S)); # close S while saving $! return undef; } unless (connect(S, $serverproc)) { ($!) = ($!, close(S)); # close S while saving $! return undef; } select((select(S), $| = 1)[0]); $next; # return symbol for switcharound } ## $handle = &chat'open_proc("command","arg1","arg2",...); ## opens a /bin/sh on a pseudo-tty sub open_proc { ## public local(@cmd) = @_; *S = ++$next; local(*TTY) = "__TTY" . time; local($pty,$tty) = &_getpty(S,TTY); die "Cannot find a new pty" unless defined $pty; local($pid) = fork; die "Cannot fork: $!" unless defined $pid; unless ($pid) { close STDIN; close STDOUT; close STDERR; setpgrp(0,$$); if (open(DEVTTY, "/dev/tty")) { ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY close DEVTTY; } open(STDIN,"<&TTY"); open(STDOUT,">&TTY"); open(STDERR,">&STDOUT"); die "Oops" unless fileno(STDERR) == 2; # sanity close(S); exec @cmd; die "Cannot exec @cmd: $!"; } close(TTY); $next; # return symbol for switcharound } # $S is the read-ahead buffer ## $return = &chat'expect([$handle,] $timeout_time, ## $pat1, $body1, $pat2, $body2, ... ) ## $handle is from previous &chat'open_*(). ## $timeout_time is the time (either relative to the current time, or ## absolute, ala time(2)) at which a timeout event occurs. ## $pat1, $pat2, and so on are regexs which are matched against the input ## stream. If a match is found, the entire matched string is consumed, ## and the corresponding body eval string is evaled. ## ## Each pat is a regular-expression (probably enclosed in single-quotes ## in the invocation). ^ and $ will work, respecting the current value of $*. ## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded. ## If pat is 'EOF', the body is executed if the process exits before ## the other patterns are seen. ## ## Pats are scanned in the order given, so later pats can contain ## general defaults that won't be examined unless the earlier pats ## have failed. ## ## The result of eval'ing body is returned as the result of ## the invocation. Recursive invocations are not thought ## through, and may work only accidentally. :-) ## ## undef is returned if either a timeout or an eof occurs and no ## corresponding body has been defined. ## I/O errors of any sort are treated as eof. sub expect { ## public if ($_[0] =‾ /$nextpat/) { *S = shift; } local($endtime) = shift; $endtime += time if $endtime < 600_000_000; local($rmask, $nfound, $timeleft, $thisbuf); local($timeout,$eof) = (1,1); local($cases,$pattern,$action); local($caller) = caller; local($return,@return); local($returnvar) = wantarray ? '@return' : '$return'; ## strategy: create a giant block inside $cases $cases .= <<'ESQ'; LOOP: { ESQ while (@_) { ($pattern,$action) = splice(@_,0,2); if ($pattern =‾ /^eof$/i) { $cases .= <<"EDQ"; if (¥$eof) { $returnvar = do { package $caller; $action; }; last LOOP; } EDQ $eof = 0; } elsif ($pattern =‾ /^timeout$/i) { $cases .= <<"EDQ"; if (¥$timeout) { $returnvar = do { package $caller; $action; }; last LOOP; } EDQ $timeout = 0; } else { $pattern =‾ s#/#¥¥/#g; $cases .= <<"EDQ"; if (¥$S =‾ /$pattern/) { ¥$S = ¥$'; $returnvar = do { package $caller; $action; }; last LOOP; } EDQ } } $cases .= <<"EDQ" if $eof; if (¥$eof) { $returnvar = undef; last LOOP; } EDQ $cases .= <<"EDQ" if $timeout; if (¥$timeout) { $returnvar = undef; last LOOP; } EDQ $eof = $timeout = 0; $cases .= <<'ESQ'; $rmask = ""; vec($rmask,fileno(S),1) = 1; ($nfound, $rmask) = select($rmask, undef, undef, $endtime - time); if ($nfound) { ""; $nread = sysread(S, $thisbuf, 1024); if ($nread > 0) { $S .= $thisbuf; } else { $eof++, redo LOOP; # any error is also eof } } else { $timeout++, redo LOOP; # timeout } redo LOOP; } ESQ eval $cases; die $@ if $@; if (wantarray) { return @return; } else { return $return; } } ## &chat'print([$handle,] @data) ## $handle is from previous &chat'open(). ## like print $handle @data sub print { ## public if ($_[0] =‾ /$nextpat/) { *S = shift; } print S @_; } ## &chat'close([$handle,]) ## $handle is from previous &chat'open(). ## like close $handle sub close { ## public if ($_[0] =‾ /$nextpat/) { *S = shift; } close(S); } # ($pty,$tty) = $chat'_getpty(PTY,TTY): # internal procedure to get the next available pty. # opens pty on handle PTY, and matching tty on handle TTY. # returns undef if can't find a pty. sub _getpty { ## private local($_PTY,$_TTY) = @_; $_PTY =‾ s/^([^']+)$/(caller)[$[]."'".$1/e; $_TTY =‾ s/^([^']+)$/(caller)[$[]."'".$1/e; local($pty,$tty); for $bank (112..127) { next unless -e sprintf("/dev/pty%c0", $bank); for $unit (48..57) { $pty = sprintf("/dev/pty%c%c", $bank, $unit); open($_PTY,"+>$pty") || next; select((select($_PTY), $| = 1)[0]); ($tty = $pty) =‾ s/pty/tty/; open($_TTY,"+>$tty") || next; select((select($_TTY), $| = 1)[0]); system "stty nl>$tty"; return ($pty,$tty); } } undef; } 1; ## ## main part ## package main; ($ftph = &chat'open_proc("ftp", "-i", "-n", $remote)) || die "Cannot open ftp"; ($_ = &chat'expect($ftph, $to_remotecmd, $ftpprompt, '$`')) || die "Cannot connect to $remote"; /unknown host/ && die "Unknown host"; &chat'print($ftph, "user $login¥n"); ($_ = &chat'expect($ftph, $to_remotecmd, 'Password: $', '$`', $ftpprompt, '$`')) || die "no prompt for ¥"user $login¥""; /^5/ && die "Cannot login as user:$login"; &chat'print($ftph, "$password¥n"); ($_ = &chat'expect($ftph, $to_remotecmd, $ftpprompt, '$`')) || die "no prompt for password input"; /^¥n2/ || die "User $login login failed"; &ftpcmd("binary", $to_soon); &ftpcmd("get etc/passwd /tmp/rftpp$$", $to_filex); if (open(pass, "/tmp/rftpp$$")) { while () { ($login, $pass, $uid, $gid) = split(/:/); $uids{$login} = eval($uid); } } unlink("/tmp/rftpp$$"); &ftpcmd("get etc/group /tmp/rftpg$$", $to_filex); if (open(group, "/tmp/rftpg$$")) { while () { ($gname, $pass, $gid) = split(/:/); $gids{$gname} = eval($gid); } close(group); } unlink("/tmp/rftpg$$"); &toplevel_ftpget(@ARGV); &chat'print($ftph, "$cmd¥n"); &chat'close($ftph); exit 0; ## ## subroutine declaretions ## sub toplevel_ftpget { local(@files) = @_; local($target, $dir, $file, $cwd); $currentlocalwd = "."; &ftpcmd("pwd", $to_remotecmd) =‾ /^2.*¥"([^"]*)¥"/ || die "Cannot get current directory"; $cwd = $1; for (@files) { ($dir, $file) = &splitpath($target = $_); unless (&ftpcd($dir)) { &msg("Cannot chdir to $dir . Skip $target .¥n"); next; } if ($file) { &ftpgetbyname($file); } else { &ftpgetall; } &ftpcd($cwd) || die "Cannot chdir to $cwd"; } } sub ftpcmd { # do one of ftp command. local($cmd, $timeout) = @_; &debug("ftp> $cmd¥n"); &chat'print($ftph, "$cmd¥n"); &chat'expect($ftph, $timeout, $ftpprompt, '$`') || die "no prompt for ¥"$cmd¥""; } sub splitpath { # split /r/s/t into /r/s/ and t. local($pathname) = @_; ($pathname =‾ m#(.*/)([^/]*)#) ? ($1, $2) : ('./', $pathname); } sub ftpgetall { # get all file/directory/link of current dir, local($files) = &ftpls; unless ($files) { &msg("Cannot do ¥"ls¥" on remote.¥n"); return; } for (split(/¥n/, $files)) { &ftpget(&lsinterpret($_)); } } sub ftpgetbyname { # get a file/directory/symlink specified by name. # don't follow symlink local($filename) = @_; local($files) = &ftpls; local(@getset); unless ($files) { &msg("Cannot do ¥"ls¥" on remote.¥n"); return undef; } for (split(/¥n/, $files)) { @getset = &lsinterpret($_); if ($getset[1] eq 'l') { if ($getset[0] =‾ /^$filename -> /) { &ftpget(@getset); } } elsif ($getset[0] eq $filename) { &ftpget(@getset); } } } sub ftpget { # Get a file/directory/symlink specified by name and inode. # Make appropriate link, set mode, owner and group. # Before call this, make it sure that specified object exists. local($fn, $type, $mod, $i, $own, $grp) = @_; local($localobject, $prevdir, $errmsg); $localobject = $currentlocalwd.'/'.$fn; if (defined($ilist[$i])) { &verbose("linking $localobject -> $ilist[$i]¥n"); link($ilist[$i], $localobject) || &msg("Cannot link.¥n"); &setattr($localobject, $mod, $own, $grp); return; } switch: { if ($type eq 'l') { $fn =‾ /^(.*) -> (.*)$/; $localobject = $currentlocalwd.'/'.$1; &verbose("symlinking $localobject -> $2¥n"); symlink($2, $localobject) || &msg("Cannot make symlink.¥n"); last switch; } if ($type eq 'd') { &verbose("making directory $localobject¥n"); if (-e $localobject) { unless (-d _ ) { &msg("Cannot make directory.¥n"); last switch; } } else { if (!mkdir($localobject, 0700)) { &msg("Cannot make directory.¥n"); last switch; } } $prevdir = $currentlocalwd; $ilist[$i] = $currentlocalwd = $localobject; unless (&ftplcd($fn)) { &msg("Cannot chdir to $currentlocalwd at local."); last switch; } unless (&ftpcd($fn)) { $errmsg = "Cannot chdir to $fn at remote."; &ftplcd("..") || die $errmsg; &msg("$errmsg¥n"); last switch; } &ftpgetall; &ftpcd("..") || die "Cannot chdir to ¥"..¥" at remote"; &ftplcd("..") || die "Cannot chdir to ¥"..¥" at local"; $currentlocalwd = $prevdir; &setattr($localobject, $mod, $own, $grp); last switch; } if ($type eq '-') { &verbose("getting file $localobject¥n"); $ilist[$i] = $localobject; unless (&ftpcmd("get ¥"$fn¥"", $to_filex)=‾/¥n226 /) { # 226 means 'Transfer complete.'. # Even if there is "226 bytes received", # it means success of transmission. &msg("Cannot get $localobject .¥n"); last switch; } &setattr($localobject, $mod, $own, $grp); last switch; } &verbose("no action for $localobject¥n@_"); } } sub ftpcd { local($ndir) = @_; &ftpcmd("cd $ndir", $to_remotecmd) =‾ /^2/; } sub ftplcd { local($ndir) = @_; if (&ftpcmd("lcd $ndir", $to_remotecmd) =‾ /^Local directory now /) { } else { }; } sub ftpls { # do ls and return result. # If failed, return undef. local(@ls, @lscomps); local($pre, $out, $post); $_ = &ftpcmd("ls -lgAi ¥"|sed 's/^/# /'¥"", $to_remotecmd); unless (/(¥n#[^¥n]*)+/) { return undef; } ($pre, $out, $post) = ($`, $&, $'); ($out =‾ s/^¥n# total ¥d+¥n//) ? $out : undef; } sub lsinterpret { local($_) = @_; local($foo, $i, $m, $s, $own, $grp, $sz, $d1, $d2, $d3, $fn) = split(/¥s+/, $_, 11); local($mod, $type, $mb); # make it sure that $fn can hold symbolic link. (' -> ') $m =‾ /(.)(.*)/; ($type, $m) = ($1, $2); $mod = 0; if ($m =‾ /(.*)t$/) { $m = $1.'x'; $mod |= 01000; } if ($m =‾ /^(.{2})s(.*)/) { $m = $1.'x'.$2; $mod |= 04000; } if ($m =‾ /^(.{5})s(.*)/) { $m = $1.'x'.$2; $mod |= 02000; } $mb = 1; while ($m) { if ('-' ne chop($m)) { $mod |= $mb; } $mb <<= 1; } ($fn, $type, $mod, $i, $own, $grp); } sub setattr { local($filename, $mod, $owner, $group) = @_; local($nuid, $ngid); if (defined($_ = $uids{$owner})) { $nuid = $_; } else { $nuid = ($owner =‾ /^¥d+$/) ? eval($owner): $nobodyuid; } if (defined($_ = $gids{$group})) { $ngid = $_; } else { $ngid = ($group =‾ /^¥d+$/) ? eval($group) : $nobodyuid; } &debug(sprintf( "setting $filename mode=%04o owner=%s(%d) group=%s(%d)¥n", $mod, $owner, $nuid, $group, $ngid)); chown($nuid, $ngid, $filename) || &msg("Cannot chown/chgrp of $filename.¥n"); chmod($mod, $filename) || &msg("Cannot chmod of $filename.¥n"); } sub msg { print STDERR @_; } sub verbose { $opt_v && print STDERR @_; } sub debug { $opt_d && print STDERR @_; } -- ----____----____ 渡邊克宏@ソフトウェア工学研究所