src/Darcs/CommandsAux.lhs

   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 \begin{code}
  19 {-# OPTIONS_GHC -cpp #-}
  20 {-# LANGUAGE CPP #-}
  21
  22 #include "gadts.h"
  23
  24 module Darcs.CommandsAux ( check_paths, malicious_patches, has_malicious_path,
  25                         ) where
  26 import Darcs.Flags ( DarcsFlag( RestrictPaths, DontRestrictPaths ) )
  27 import UglyFileName ( breakup, is_explicitly_relative )
  28 import Darcs.Patch ( Patchy, list_touched_files )
  29 import Darcs.Ordered ( FL, mapFL )
  30 import Darcs.Sealed ( Sealed2(..), unseal2 )
  31 import Darcs.Global ( darcsdir )
  32 import Data.List ( intersect )
  33 \end{code}
  34
  35 \begin{code}
  36 -- * File paths
  37 {-
  38   Darcs will operate on files and directories with the invoking user's
  39   privileges. The paths for these files and directories are stored in
  40   patches, which darcs receives in various ways. Even though darcs will not
  41   create patches with "unexpected" file paths, there are no such guarantees
  42   for received patches. A spoofed patch could inflict changes on any file
  43   or directory which the invoking user is privileged to modify.
  44
  45   There is no one single "apply" function that can check paths, so each
  46   command is responsible for not applying patches without first checking
  47   them with one of these function when appropriate.
  48 -}
  49
  50 {- |
  51   A convenience function to call from all darcs command functions before
  52   applying any patches. It checks for malicious paths in patches, and
  53   prints an error message and fails if it finds one.
  54 -}
  55 check_paths :: Patchy p => [DarcsFlag] -> FL p C(x y) -> IO ()
  56 check_paths opts patches
  57   = if check_is_on  && or (mapFL has_malicious_path patches)
  58       then fail "Malicious path"
  59            -- TODO: print patch(es) and path(s)
  60            -- NOTE: should use safe Doc printer, this can be evil chars
  61       else return ()
  62  where
  63     check_is_on = DontRestrictPaths `notElem` opts  ||
  64                   RestrictPaths        `elem` opts
  65
  66 -- | Filter out patches that contains some malicious file path
  67 malicious_patches :: Patchy p => [Sealed2 p] -> [Sealed2 p]
  68 malicious_patches to_check = filter (unseal2 has_malicious_path) to_check
  69
  70 has_malicious_path :: Patchy p => p C(x y) -> Bool
  71 has_malicious_path patch =
  72   let paths = list_touched_files patch in
  73     any is_malicious_path paths
  74
  75 {-|
  76   What is a malicious path?
  77
  78   A spoofed path is a malicious path.
  79
  80   1. Darcs only creates explicitly relative paths (beginning with @\".\/\"@),
  81      so any not explicitly relative path is surely spoofed.
  82
  83   2. Darcs normalizes paths so they never contain @\"\/..\/\"@, so paths with
  84      @\"\/..\/\"@ are surely spoofed.
  85
  86   A path to a darcs repository's meta data can modify \"trusted\" patches or
  87   change safety defaults in that repository, so we check for paths
  88   containing @\"\/_darcs\/\"@ which is the entry to darcs meta data.
  89
  90   To do?
  91
  92   * How about get repositories?
  93
  94   * Would it be worth adding a --semi-safe-paths option for allowing
  95     changes to certain preference files (_darcs\/prefs\/) in sub
  96     repositories'?
  97 -}
  98 is_malicious_path :: String -> Bool
  99 is_malicious_path fp =
 100     not (is_explicitly_relative fp) ||
 101     breakup fp `contains_any` [ "..", darcsdir ]
 102  where
 103     contains_any a b = not . null $ intersect a b
 104 \end{code}