diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2010, IlyaPortnov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of IlyaPortnov nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/System/Plugins/Safe.hs b/System/Plugins/Safe.hs new file mode 100644 --- /dev/null +++ b/System/Plugins/Safe.hs @@ -0,0 +1,113 @@ +module System.Plugins.Safe + (Extension, + Arg, + Symbol, + LoadStatus (..), + loadOneValue) + where + +import Data.Char +import System.Plugins hiding (Module, loadModule) +import System.Plugins.Utils (Arg) +import System.FilePath +import System.Directory +import System.Unix.Directory +import Language.Haskell.Exts +import Text.Printf + +capitalize :: String -> String +capitalize [] = [] +capitalize (x:xs) = toUpper x: xs + +parseMode :: String -> [Extension] -> ParseMode +parseMode name exts = defaultParseMode {parseFilename = name, extensions = exts} + +setModuleName :: String -> Module -> Module +setModuleName name (Module loc _ pragmas warns exports imports decls) = + Module loc (ModuleName name) pragmas warns exports imports decls + +getModuleName :: Module -> String +getModuleName (Module _ (ModuleName name) _ _ _ _ _) = name + +fromModuleName :: ModuleName -> String +fromModuleName (ModuleName s) = s + +loadModule :: [Extension] -> FilePath -> IO Module +loadModule exts sourcePath = do + let name = takeBaseName sourcePath + result <- parseFileWithMode (parseMode name exts) sourcePath + case result of + ParseOk mod -> return $ setModuleName (capitalize name) mod + ParseFailed loc err -> fail $ errMsg loc err + where + errMsg loc err = printf "Parse error in %s, line %d, col. %d: %s" + (srcFilename loc) + (srcLine loc) + (srcColumn loc) + err + +fixModule :: [Extension] -> [String] -> [String] -> String -> Module -> Module +fixModule exts forcedImports allowedImports symbol (Module loc name _ _ _ imports decls) = + Module loc name pragmas Nothing exports fixedImports safeDecls + where + pragmas | null exts = [] + | otherwise = [LanguagePragma zeroLoc $ map (Ident . show) exts] + zeroLoc = SrcLoc (fromModuleName name) 0 0 + fixedImports = filter isAllowed imports ++ forcedImportsDecls + isAllowed decl = fromModuleName (importModule decl) `elem` allowedImports + forcedImportsDecls = map mkImportDecl forcedImports + mkImportDecl name = ImportDecl zeroLoc (ModuleName name) False False Nothing Nothing Nothing + exports = Just [EVar (UnQual (Ident symbol))] + safeDecls = filter isSafe decls + isSafe (ForImp {}) = False + isSafe (ForExp {}) = False + isSafe _ = True + +writeModule :: FilePath -> Module -> IO () +writeModule path mod = do + let src = prettyPrint mod +-- putStrLn src + writeFile path src + +withTemporaryDirectory' _ f = f "." + +-- | Load one specified symbol from Haskell source file. +-- That source will be: +-- +-- * Forced to use specified language extensions; +-- +-- * Forced to import specified modules; +-- +-- * Allowed to import specified set of modules; +-- +-- * Forbidden to import any other modules; +-- +-- * Forbidden to use any FFI declarations. +-- +-- Unsafe declarations will be simply removed from module. +-- +-- WARNING: source file name should start with capital letter. +loadOneValue :: + [Arg] -- ^ Any command-line arguments for compiler + -> [FilePath] -- ^ Include paths + -> FilePath -- ^ Source file name + -> [Extension] -- ^ Language extensions to enable + -> [String] -- ^ Force this modules to be imported by plugin + -> [String] -- ^ Allow to import this modules + -> Symbol -- ^ Symbol to load + -> IO (LoadStatus a) +loadOneValue args paths sourcePath exts forcedImports allowedImports symbol = do + let name = takeFileName sourcePath + mod <- loadModule exts sourcePath + pwd <- getCurrentDirectory + res <- withTemporaryDirectory "safe-plugin" $ \dir -> do + setCurrentDirectory dir + let newPath = dir name + writeModule newPath (fixModule exts forcedImports allowedImports symbol mod) + mst <- makeAll newPath args + case mst of + MakeFailure errs -> return $ LoadFailure errs + MakeSuccess _ obj -> load obj paths [] symbol + setCurrentDirectory pwd + return res + diff --git a/safe-plugins.cabal b/safe-plugins.cabal new file mode 100644 --- /dev/null +++ b/safe-plugins.cabal @@ -0,0 +1,61 @@ +Name: safe-plugins +Version: 0.1 + +Synopsis: A small wrapper over hs-plugins to allow loading safe plugins + +-- A longer description of the package. +Description: This library allows you to load plugins, just as hs-plugins do. + But under some circumstances, you do not want to allow + plugins to do everything they want. What about plugin + which executes `rm -rf /*' ? In Haskell, you can limit + plugin's abilities just by not allowing it to import `not + safe' modules (System.IO.Unsafe, etc). With this library, + you specify a list of modules that plugin should be forced + to import (i.e., some plugin API module), and a list of + module that you want to allow plugin to import (some + `surely safe' modules). Plugin cannot import any other + modules. Moreover, you can specify some language + extensions, for example, NoImplicitPrelude. + +-- The license under which the package is released. +License: BSD3 + +-- The file containing the license text. +License-file: LICENSE + +-- The package author(s). +Author: IlyaPortnov + +-- An email address to which users can send suggestions, bug reports, +-- and patches. +Maintainer: portnov84@rambler.ru + +-- A copyright notice. +-- Copyright: + +Category: System + +Build-type: Simple + +-- Extra files to be distributed with the package, such as examples or +-- a README. +-- Extra-source-files: + +-- Constraint on the version of Cabal needed to build this package. +Cabal-version: >=1.6 + + +Library + -- Modules exported by the library. + Exposed-modules: System.Plugins.Safe + + -- Packages needed in order to build this package. + Build-depends: base >= 3 && <= 5, directory, filepath, Unixutils, + plugins, haskell-src-exts + + -- Modules not exported by this package. + -- Other-modules: + + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. + -- Build-tools: +