%  Copyright (C) 2003 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; if not, write to the Free Software Foundation,
%  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
\section{Creating pushable repositories}
\label{darcs_createrepo}

\begin{code}
module Main (main) where

import System
import IO
import Directory ( setCurrentDirectory )
import Monad ( unless )
\end{code}

A convenient utility called \verb!darcs-createrepo! is provided to easily
set up pushable repositories.  This utility creates a new user and sets
that user up to recieve and validate patches via email.  Because
\verb!darcs-createrepo! must create a new user, it needs to be run as root.
It will prompt you for all the information it needs.

\verb!darcs-createrepo! creates a repo with no users having write
privileges.  Moreover, the \verb!allowed_keys! file is created as
root-owned, so only root will be able to add allowed users.  You probably
will want to \verb!chown! this file to some administrative user.  In any
case, you'll need to add a few users' gpg keys to this file via gpg's
\verb!--import! or \verb!--recv-keys! commands.

\begin{code}
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "What is to be the repo email address? "
  email <- getLine
  username <- return $ takeWhile (/='@') email
  putStr $ "Creating user '"++ username ++ "'...\n"
  home <- return $ "/var/lib/darcs/repos/"++username
  sysnofail ("/usr/sbin/adduser --system --home "
             ++home++" "++username)
            ("Error creating user '"++username++"'")
  putStr "What email address should I forward unauthorized patches to? "
  replyemail <- getLine
  putStr "Where is the existing repository I am to start with? "
  oldrepo <- getLine
  putStr $ "Old repo is "++oldrepo++"\n"
  setCurrentDirectory home
  writeFile "allowed_keys" ""
  writeFile ".forward" $
            "|(umask 022;"++
            "darcs apply --verify "++home++"/allowed_keys"++
            " --reply "++replyemail++" --repodir "++home++"/repo"++
            " --no-resolve-conflicts)"
  sysnofail ("chown "++username++" .forward")
       "Error chown'ing the .forward file"
  sysnofail "mkdir -p /var/www/repos" "Error creating /var/www/repos"
  sysnofail ("sudo -u "++username++" darcs get --repo-name repo "++oldrepo)
            "Error copying over from the old repo."
  sysnofail ("ln -s "++home++"/repo /var/www/repos/"++username)
            "Error creating symlink in /var/www/repos"
  writeFile "repo/_darcs/prefs/email" email
  writeFile "repo/_darcs/prefs/defaults" "apply test\n"
  sysnofail ("chown "++username++" repo/_darcs/patches/* repo/_darcs/prefs/*")
            "Error fixing ownership on repo patches."
  putStrLn $ "Finished creating repository "++username
  putStrLn $ "Now you need to add some public keys to "++home++"/allowed_keys"

sysnofail :: String -> String -> IO ()
sysnofail s e = do retval <- system s
                   unless (retval == ExitSuccess) $ do
                     putStr $ e ++ "\n"
                     exitWith retval
\end{code}