% Copyright (C) 2008 David Roundy
%
% This program is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2, or (at your option)
% any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with this program; see the file COPYING. If not, write to
% the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
% Boston, MA 02110-1301, USA.
\darcsCommand{transfer-mode}
\begin{code}

{-# OPTIONS_GHC -cpp -fglasgow-exts #-}{-# LANGUAGE CPP, PatternGuards #-}-- The pragma above is only for pattern guards.moduleDarcs.Commands.TransferMode(transferMode)whereimportPreludehiding(catch)importControl.Exception.Extensible(catch)importSystem.IO(stdout,hFlush)importDarcs.Utils(withCurrentDirectory,prettyException)importDarcs.Commands(DarcsCommand(..),nodefaults)importDarcs.Arguments(DarcsFlag,workingRepoDir)importDarcs.Repository(amInRepository)importProgress(setProgressMode)importDarcs.Global(darcsdir)importqualifiedData.ByteStringasB(hPut,readFile,length,ByteString)transferModeDescription::StringtransferModeDescription="Internal command for efficient ssh transfers."transferModeHelp::StringtransferModeHelp="When pulling from or pushing to a remote repository over ssh, if both\n"++"the local and remote ends have Darcs 2, the `transfer-mode' command\n"++"will be invoked on the remote end. This allows Darcs to intelligently\n"++"transfer information over a single ssh connection.\n"++"\n"++"If either end runs Darcs 1, a separate ssh connection will be created\n"++"for each transfer. As well as being less efficient, this means users\n"++"who do not run ssh-agent will be prompted for the ssh password tens or\n"++"hundreds of times!\n"transferMode::DarcsCommandtransferMode=DarcsCommand{commandName="transfer-mode",commandHelp=transferModeHelp,commandDescription=transferModeDescription,commandExtraArgs=0,commandExtraArgHelp=[],commandGetArgPossibilities=return[],commandCommand=transferModeCmd,commandPrereq=amInRepository,commandArgdefaults=nodefaults,commandAdvancedOptions=[],commandBasicOptions=[workingRepoDir]}transferModeCmd::[DarcsFlag]->[String]->IO()transferModeCmd__=dosetProgressModeFalseputStrLn"Hello user, I am darcs transfer mode"hFlushstdoutwithCurrentDirectorydarcsdir$transfertransfer::IO()transfer=do'g':'e':'t':' ':fn<-getLinex<-readfilefncasexofRightc->doputStrLn$"got "++fnputStrLn$show$B.lengthcB.hPutstdoutchFlushstdoutLefte->doputStrLn$"error "++fnputStrLn$showehFlushstdouttransferreadfile::String->IO(EitherStringB.ByteString)readfilefn=(Right`fmap`B.readFilefn)`catch`(\e->return$Left(prettyExceptione))