1 -- Copyright (C) 2006 Tommy Pettersson <ptp@lysator.liu.se>
    2 --
    3 -- This program is free software; you can redistribute it and/or modify
    4 -- it under the terms of the GNU General Public License as published by
    5 -- the Free Software Foundation; either version 2, or (at your option)
    6 -- any later version.
    7 --
    8 -- This program is distributed in the hope that it will be useful,
    9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 -- GNU General Public License for more details.
   12 --
   13 -- You should have received a copy of the GNU General Public License
   14 -- along with this program; see the file COPYING.  If not, write to
   15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 -- Boston, MA 02110-1301, USA.
   17 
   18 {-# OPTIONS_GHC -cpp #-}
   19 {-# LANGUAGE CPP #-}
   20 
   21 #include "gadts.h"
   22 
   23 module Darcs.CommandsAux ( check_paths, malicious_patches, has_malicious_path,
   24                         ) where
   25 import Darcs.Flags ( DarcsFlag( RestrictPaths, DontRestrictPaths ) )
   26 import Darcs.Patch ( Patchy, list_touched_files )
   27 import Darcs.Ordered ( FL, mapFL )
   28 import Darcs.Sealed ( Sealed2(..), unseal2 )
   29 import Darcs.Global ( darcsdir )
   30 import Data.List ( intersect )
   31 import System.FilePath ( splitDirectories )
   32 
   33 -- * File paths
   34 {-
   35   Darcs will operate on files and directories with the invoking user's
   36   privileges. The paths for these files and directories are stored in
   37   patches, which darcs receives in various ways. Even though darcs will not
   38   create patches with "unexpected" file paths, there are no such guarantees
   39   for received patches. A spoofed patch could inflict changes on any file
   40   or directory which the invoking user is privileged to modify.
   41 
   42   There is no one single "apply" function that can check paths, so each
   43   command is responsible for not applying patches without first checking
   44   them with one of these function when appropriate.
   45 -}
   46 
   47 {- |
   48   A convenience function to call from all darcs command functions before
   49   applying any patches. It checks for malicious paths in patches, and
   50   prints an error message and fails if it finds one.
   51 -}
   52 check_paths :: Patchy p => [DarcsFlag] -> FL p C(x y) -> IO ()
   53 check_paths opts patches
   54   = if check_is_on  && or (mapFL has_malicious_path patches)
   55       then fail $ unlines $ ["Malicious path in patch:"] ++
   56                             (map (\s -> "    " ++ s) $ concat $ mapFL malicious_paths patches) ++
   57                             ["", "If you are sure this is ok then you can run again with the --dont-restrict-paths option."]
   58            -- TODO: print patch(es)
   59            -- NOTE: should use safe Doc printer, this can be evil chars
   60       else return ()
   61  where
   62     check_is_on = DontRestrictPaths `notElem` opts  ||
   63                   RestrictPaths        `elem` opts
   64 
   65 -- | Filter out patches that contains some malicious file path
   66 malicious_patches :: Patchy p => [Sealed2 p] -> [Sealed2 p]
   67 malicious_patches to_check = filter (unseal2 has_malicious_path) to_check
   68 
   69 has_malicious_path :: Patchy p => p C(x y) -> Bool
   70 has_malicious_path patch =
   71     case malicious_paths patch of
   72       [] -> False
   73       _ -> True
   74 
   75 malicious_paths :: Patchy p => p C(x y) -> [String]
   76 malicious_paths patch =
   77   let paths = list_touched_files patch in
   78     filter is_malicious_path paths
   79 
   80 {-|
   81   What is a malicious path?
   82 
   83   A spoofed path is a malicious path.
   84 
   85   1. Darcs only creates explicitly relative paths (beginning with @\".\/\"@),
   86      so any not explicitly relative path is surely spoofed.
   87 
   88   2. Darcs normalizes paths so they never contain @\"\/..\/\"@, so paths with
   89      @\"\/..\/\"@ are surely spoofed.
   90 
   91   A path to a darcs repository's meta data can modify \"trusted\" patches or
   92   change safety defaults in that repository, so we check for paths
   93   containing @\"\/_darcs\/\"@ which is the entry to darcs meta data.
   94 
   95   To do?
   96 
   97   * How about get repositories?
   98 
   99   * Would it be worth adding a --semi-safe-paths option for allowing
  100     changes to certain preference files (_darcs\/prefs\/) in sub
  101     repositories'?
  102 -}
  103 is_malicious_path :: String -> Bool
  104 is_malicious_path fp =
  105     not (is_explicitly_relative fp) ||
  106     splitDirectories fp `contains_any` [ "..", darcsdir ]
  107  where
  108     contains_any a b = not . null $ intersect a b
  109 
  110 is_explicitly_relative :: String -> Bool
  111 is_explicitly_relative ('.':'/':_) = True  -- begins with "./"
  112 is_explicitly_relative _ = False