#7453 closed bug (fixed)

unsafe coerce without extensions

Reported by: guest Owned by: igloo
Priority: normal Milestone:
Component: Compiler (Type checker) Version: 7.6.1
Keywords: Cc: pho@…, ekmett@…, haskell.org@…, emertens@…, pumpkingod@…
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: GHC accepts invalid program Difficulty: Unknown
Test Case: T7453 Blocked By:
Blocking: Related Tickets:

Description

The following program implements an unsafe coerce and works on versions of GHC at least as far back as 7.0.3 but is fixed in HEAD. I'm reporting this because I don't know if it was fixed on purpose and might merit at least a fix to the 7.6.X branch if not the 7.4.X branch (due to its use in the platform)

newtype Id a = Id { runId :: a }

-- Providing this type triggers a type-error
-- cast :: a -> b
cast v = runId z
  where
  z :: Id v
  z = aux
    where
    aux = Id v

Example usage:

*Main> map cast [97..107 :: Int] :: String
"abcdefghijk"

*Main> cast (Just True) :: String
"\-1152921504589708267Segmentation fault: 11

Change History (16)

comment:1 Changed 17 months ago by guest

Reported by Eric Mertens <emertens@…> with help from Edward A. Kmett <ekmett@…> after I encountering this bug in the course of using one of his libraries.

comment:2 Changed 17 months ago by PHO

  • Cc pho@… added

comment:3 Changed 17 months ago by ekmett

You don't even need a newtype:

ghci> let unsafeCoerce v = z () where z :: () -> v; z = aux where aux = const v

comment:4 Changed 17 months ago by pumpkin

You don't even need to use the aux (the where block must be there, and do that, though):

let unsafeCoerce v = z () where z :: () -> v; z = const v where _ = const v

comment:5 Changed 17 months ago by ekmett

  • Cc ekmett@… added

z can be simplified

let unsafeCoerce v = z where z :: v; z = v where aux = const v

Note: this doesn't happen if you use aux _ = v

comment:6 Changed 17 months ago by ion1

  • Cc haskell.org@… added

comment:7 Changed 17 months ago by ion1

This has some security implications as well.

% mueval -e 'let unsafeCoerce v = z where z :: v; z = v where aux = const v in (unsafeCoerce (putStrLn "evil IO action") :: () -> ()) ()'
evil IO action
()

comment:8 Changed 17 months ago by glguy

  • Cc emertens@… added

comment:9 Changed 17 months ago by pumpkin

  • Cc pumpkingod@… added

comment:10 Changed 17 months ago by igloo

  • Difficulty set to Unknown
  • Test Case set to T7453

Added as a regression test, thanks.

comment:11 Changed 17 months ago by simonpj

  • Resolution set to wontfix
  • Status changed from new to closed

Well this is embarrassing. It looks as if there's been a missing (or missed) skolem-escape check in GHC for a long time. I re-engineered and simplified the bit that deals with inferring types for bindings, after 7.6, so I expect that's what has fixed it.

I'm not very keen on peering into the bowels of 7.6 to find out what is going on, though; it's clearly not that easy to trip over if it's been around for so long without anyone noticing. If you are worried about security, use -dcore-lint, which picks up the bug right away.

So for now I'll mark it as "wont-fix" meaning "fixed in HEAD, wont-fix in 7.6". Is that acceptable?

Simon

comment:12 Changed 17 months ago by simonmar

Hmm, now that we have Safe Haskell, bugs that expose holes in the type system are more serious. I don't think we ought to leave this unfixed in 7.6.2.

comment:13 Changed 17 months ago by simonpj

  • Resolution wontfix deleted
  • Status changed from closed to new

comment:14 Changed 17 months ago by simonpj

Here is a fix for the 7.6 branch

commit b637a24dbb471d99887e5544037a2abe10af26ee
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date:   Mon Dec 3 16:57:30 2012 +0000

    Fix Trac #7453 on the 7.6 branch
    
    This patch fixes a quite egregious bug. runTcS was intialising
    the 'untouchables' to NoUntouchables, which is quite wrong for
    the invocation in TcSimplify.simplifyInfer.  Result: missed
    skolem-escape check and seg-fault city.
    
    All this is done differently, and better, in HEAD, so this
    patch is needed only on the branch.

>---------------------------------------------------------------

 compiler/typecheck/TcSMonad.lhs |   10 +++++++++-
 1 files changed, 9 insertions(+), 1 deletions(-)

diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index eaaa8f6..8adb1d5 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -935,6 +935,15 @@ runTcSWithEvBinds ev_binds_var tcs
        ; inert_var <- TcM.newTcRef is 
        ; wl_var <- TcM.newTcRef wl
 
+       -- The "low end" of the untouchable range should come from the
+       -- ambient tcl_untch; the high end is the highest allocated to
+       -- date. 'untouch' used (in 7.6.1, entirely wrongly) to be
+       -- set to NoUntouchables, causing #7453.
+       -- All this is done much better in 7.8.
+       ; tc_lenv <- TcM.getLclEnv
+       ; tcm_high <- TcM.readTcRef (tcl_meta tc_lenv)
+       ; let untouch = TouchableRange tcm_low tcm_high
+             tcm_low = tcl_untch tc_lenv
        ; let env = TcSEnv { tcs_ev_binds = ev_binds_var
                           , tcs_ty_binds = ty_binds_var
                           , tcs_untch    = (untouch, emptyVarSet) -- No Tcs untouchables yet
@@ -960,7 +969,6 @@ runTcSWithEvBinds ev_binds_var tcs
        ; return res }
   where
     do_unification (tv,ty) = TcM.writeMetaTyVar tv ty
-    untouch = NoUntouchables
     is = emptyInert
     wl = emptyWorkList

comment:15 Changed 17 months ago by simonpj

  • Owner set to igloo

OK I think that fixes the 7.6 branch. Ian can you double check? I'm not sure not sure if it's worth adding a regression test to the branch or not.

Simon

comment:16 Changed 15 months ago by igloo

  • Resolution set to fixed
  • Status changed from new to closed

It now works (i.e. is rejected with an error) in the 7.6 branch.

Note: See TracTickets for help on using tickets.