packages feed

safe-plugins (empty) → 0.1

raw patch · 4 files changed

+206/−0 lines, 4 filesdep +Unixutilsdep +basedep +directorysetup-changed

Dependencies added: Unixutils, base, directory, filepath, haskell-src-exts, plugins

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Plugins/Safe.hs view
@@ -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+
+ safe-plugins.cabal view
@@ -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:         +