-- Copyright (C) 2006 Tommy Pettersson <ptp@lysator.liu.se>
--
-- 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.

module Darcs.UI.CommandsAux
    ( checkPaths
    , maliciousPatches
    , hasMaliciousPath
    ) where

import Prelude ()
import Darcs.Prelude

import Control.Monad ( when )

import Darcs.UI.Flags ( DarcsFlag )
import Darcs.UI.Options ( parseFlags )
import Darcs.UI.Options.All ( restrictPaths )
import Darcs.Patch.Inspect ( PatchInspect, listTouchedFiles )
import Darcs.Patch.Witnesses.Ordered ( FL, mapFL )
import Darcs.Patch.Witnesses.Sealed ( Sealed2(..), unseal2 )
import Darcs.Util.Path ( isMaliciousPath )

-- * File paths
{-
  Darcs will operate on files and directories with the invoking user's
  privileges. The paths for these files and directories are stored in
  patches, which darcs receives in various ways. Even though darcs will not
  create patches with "unexpected" file paths, there are no such guarantees
  for received patches. A spoofed patch could inflict changes on any file
  or directory which the invoking user is privileged to modify.

  There is no one single "apply" function that can check paths, so each
  command is responsible for not applying patches without first checking
  them with one of these function when appropriate.
-}

{- |
  A convenience function to call from all darcs command functions before
  applying any patches. It checks for malicious paths in patches, and
  prints an error message and fails if it finds one.
-}
checkPaths :: PatchInspect p => [DarcsFlag] -> FL p wX wY -> IO ()
checkPaths :: [DarcsFlag] -> FL p wX wY -> IO ()
checkPaths opts :: [DarcsFlag]
opts patches :: FL p wX wY
patches
  = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Bool)
-> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Bool
restrictPaths [DarcsFlag]
opts Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((forall wW wZ. p wW wZ -> Bool) -> FL p wX wY -> [Bool]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> Bool
forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> Bool
hasMaliciousPath FL p wX wY
patches)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ["Malicious path in patch:"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                         (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("    " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (forall wW wZ. p wW wZ -> [String]) -> FL p wX wY -> [[String]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. p wW wZ -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
maliciousPaths FL p wX wY
patches) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                         ["", "If you are sure this is ok then you can run again with the --dont-restrict-paths option."]
           -- TODO: print patch(es)
           -- NOTE: should use safe Doc printer, this can be evil chars

-- | Filter out patches that contains some malicious file path
maliciousPatches :: PatchInspect p => [Sealed2 p] -> [Sealed2 p]
maliciousPatches :: [Sealed2 p] -> [Sealed2 p]
maliciousPatches = (Sealed2 p -> Bool) -> [Sealed2 p] -> [Sealed2 p]
forall a. (a -> Bool) -> [a] -> [a]
filter ((forall wX wY. p wX wY -> Bool) -> Sealed2 p -> Bool
forall (a :: * -> * -> *) b.
(forall wX wY. a wX wY -> b) -> Sealed2 a -> b
unseal2 forall wX wY. p wX wY -> Bool
forall (p :: * -> * -> *) wX wY. PatchInspect p => p wX wY -> Bool
hasMaliciousPath)

hasMaliciousPath :: PatchInspect p => p wX wY -> Bool
hasMaliciousPath :: p wX wY -> Bool
hasMaliciousPath patch :: p wX wY
patch =
    case p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
maliciousPaths p wX wY
patch of
      [] -> Bool
False
      _ -> Bool
True

maliciousPaths :: PatchInspect p => p wX wY -> [String]
maliciousPaths :: p wX wY -> [String]
maliciousPaths patch :: p wX wY
patch =
  let paths :: [String]
paths = p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles p wX wY
patch in
    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isMaliciousPath [String]
paths