\subsection{darcs put} \begin{code} {-# OPTIONS_GHC -cpp #-} module Darcs.Commands.Put ( put ) where import System.Exit ( ExitCode( ExitSuccess, ExitFailure ), exitWith ) import Control.Monad ( when ) import Data.Maybe ( catMaybes ) import System.Directory ( createDirectory ) import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( DarcsFlag( Quiet, Verbose, UseFormat2, UseHashedInventory, UseOldFashionedInventory ), applyas, match_one_context, fix_filepath, ssh_cm, flagToString, get_inventory_choices, set_scripts_executable, working_repo_dir, set_default, ) import Darcs.Repository ( withRepoReadLock, ($-), patchSetToPatches, read_repo, amInRepository ) import Darcs.Repository.Format ( identifyRepoFormat, RepoProperty ( Darcs2, HashedInventory ), format_has ) import Darcs.Patch.Bundle ( make_bundle2 ) import Darcs.Patch.Ordered ( FL(..) ) import Darcs.Match ( have_patchset_match, get_one_patchset ) import Darcs.RepoPath ( toPath ) import Darcs.Repository.Prefs ( get_preflist, set_defaultrepo ) import Darcs.URL ( is_url, is_file, is_relative ) import Darcs.Utils ( withCurrentDirectory ) import Darcs.Progress ( debugMessage ) import Darcs.FilePathUtils ( absolute_dir ) import Darcs.SlurpDirectory ( empty_slurpy ) import Darcs.External ( execSSH ) import Darcs.RemoteApply ( remote_apply ) import Darcs.Commands.Init ( initialize ) import Darcs.Email ( make_email ) import Darcs.Sealed ( Sealed(..), seal ) #include "impossible.h" \end{code} \begin{code} put_description :: String put_description = "Makes a copy of the repository" \end{code} \options{put} \haskell{put_help} \begin{code} put_help :: String put_help = "Put is the opposite of get. Put copies the content of the current \n" ++ "repository and puts it in a newly created repository.\n" \end{code} \begin{code} put ::DarcsCommand put = DarcsCommand {command_name = "put", command_help = put_help, command_description = put_description, command_extra_args = 1, command_extra_arg_help = [""], command_command = put_cmd, command_prereq = amInRepository, command_get_arg_possibilities = get_preflist "repos", command_argdefaults = nodefaults, command_advanced_options = [applyas, ssh_cm], command_basic_options = [match_one_context, set_scripts_executable, get_inventory_choices, set_default, working_repo_dir]} \end{code} \begin{code} put_cmd :: [DarcsFlag] -> [String] -> IO () put_cmd _ [""] = fail "Empty repository argument given to put." put_cmd opts [unfixedrepodir] = let am_quiet = Quiet `elem` opts putInfo s = when (not am_quiet) $ putStrLn s putVerbose = when (Verbose `elem` opts) . putStrLn repodir = if is_relative unfixedrepodir then toPath $ fix_filepath opts unfixedrepodir else unfixedrepodir in do -- Test to make sure we aren't trying to push to the current repo cur_absolute_repo_dir <- absolute_dir "." req_absolute_repo_dir <- absolute_dir repodir when (cur_absolute_repo_dir == req_absolute_repo_dir) $ fail "Can't put to current repository!" when (is_url req_absolute_repo_dir) $ error "Can't put to a URL!" debugMessage "Creating repository" putVerbose "Creating repository" rf_or_e <- identifyRepoFormat "." rf <- case rf_or_e of Left e -> fail e Right x -> return x let initopts = if format_has Darcs2 rf then UseFormat2:filter (/= UseOldFashionedInventory) opts else if format_has HashedInventory rf && not (UseOldFashionedInventory `elem` opts) then UseHashedInventory:filter (/= UseFormat2) opts else filter (/= UseFormat2) opts if is_file req_absolute_repo_dir then do createDirectory req_absolute_repo_dir withCurrentDirectory req_absolute_repo_dir $ (command_command initialize) initopts [] else do -- is_ssh req_absolute_repo_dir remoteInit req_absolute_repo_dir initopts withCurrentDirectory cur_absolute_repo_dir $ withRepoReadLock opts $- \repository -> do set_defaultrepo req_absolute_repo_dir opts Sealed patchset <- if have_patchset_match opts then do ps <- get_one_patchset repository opts -- todo: make sure get_one_patchset has the right type return . seal $ ps else read_repo repository Sealed patchset2 <- if have_patchset_match opts then do ps <- get_one_patchset repository opts -- todo: make sure get_one_patchset has the right type return . seal $ ps else read_repo repository let patches = patchSetToPatches patchset patches2 = patchSetToPatches patchset2 nullFL NilFL = True nullFL _ = False when (nullFL patches) $ do putInfo "No patches were selected to put. Nothing to be done." exitWith ExitSuccess let bundle = (make_bundle2 opts empty_slurpy [] patches patches2) message = if is_file req_absolute_repo_dir then bundle else make_email req_absolute_repo_dir Nothing bundle Nothing putVerbose "Applying patches in new repository..." rval <- remote_apply opts req_absolute_repo_dir message case rval of ExitFailure ec -> do putStrLn $ "Apply failed!" exitWith (ExitFailure ec) ExitSuccess -> putInfo "Put successful." put_cmd _ _ = impossible remoteInit :: FilePath -> [DarcsFlag] -> IO () remoteInit repo opts = do let args = catMaybes $ map (flagToString $ command_basic_options initialize) opts command = "darcs initialize --repodir='" ++ path ++ "' " ++ unwords args exitCode <- execSSH addr command when (exitCode /= ExitSuccess) $ fail "Couldn't initialize remote repository." where (addr,':':path) = break (==':') repo \end{code} \emph{WARNING:} Put is far less optimized than get, especially for local repositories. We recommend avoiding use of put except for small repositories. Put is used when you already have a repository and want to make a copy of it. A typical use-case is when you want to branch your project. Put works by first initializing a repository. If the new repository is not on the local file system then darcs will login to the remote host and run \verb!darcs init! there. After the new repository is created all selected patches will be pushed just as with the command \verb!push!. \begin{options} --apply-as \end{options} If you give the \verb!--apply-as! flag, darcs will use sudo to apply the changes as a different user. This can be useful if you want to set up a system where several users can modify the same repository, but you don't want to allow them full write access. This isn't secure against skilled malicious attackers, but at least can protect your repository from clumsy, inept or lazy users. \begin{options} --context, --tag, --to-patch, --to-match \end{options} If you want to put a specific version of a repository, you have a few options. You can either use the \verb!--tag!, \verb!--to-patch! or \verb!--to-match! options, or you can use the \verb!--context=FILENAME! option, which specifies a file containing a context generated with \verb!darcs changes --context!. This allows you (for example) to include in your compiled program an option to output the precise version of the repository from which it was generated, and then perhaps ask users to include this information in bug reports. Note that when specifying \verb!--to-patch! or \verb!--to-match!, you may get a version of your code that has never before been seen, if the patches have gotten themselves reordered. If you ever want to be able to precisely reproduce a given version, you need either to tag it or create a context file.