benny_ has quit [Read error: 110 (Connection timed out)]
pants1 has joined #ocaml
psnively has quit []
smimou has quit ["bli"]
seafoodX has quit []
Clintach has joined #ocaml
seafoodX has joined #ocaml
<seafoodX>
Hi guys. I've been programming in OCaml for about seven months now. I really like it although I probably still like Haskell more. I want to task you guys a question about structuring programs. I'm working on a piece of software which I didn't write originally. Many of the functions are LARGE. What I find is that there are a whole lot of intermediate functions between the header of the function and the body. Often more than one page.
<seafoodX>
I'd like a way to get from the function LHS to the body in emacs (or some other editor)
<seafoodX>
To do this is going to require more than just regular expressions.
<Smerdyakov>
You want to step through function definitions in order?
<Smerdyakov>
Or you consider local function definitions not to be part of "the body"?
<seafoodX>
Smerdyakov: In Haskell you have "where" clauses which are great because you can put all the helper functions in there. The body appears right after the function LHS. I generally find that facilitates a top-down reading of the function. In OCaml I find I have to jump past all the intermediate functions to find the body to achieve the same effect. Otherwise, I could read the function in a bottom-up manner but I find that this is too hard for
<Smerdyakov>
OK, so you have some definition of "body" that ignores local function definitions.
<seafoodX>
Yeah, I should have been more clear.
<Smerdyakov>
I don't know of a way to do that.
<seafoodX>
I guess I'm talking about the bit of code after the last local function.
<Smerdyakov>
Usually indentation gives this away.
TFK has joined #ocaml
<seafoodX>
Yes, it does. And this is how I do things at the moment. I set my cursor to a particular indentation and then scroll down to the "body"
<seafoodX>
But it's annoying.
<seafoodX>
Also, I'd love to see some editor support (in some nice GUI) where you could collapse and expand function declarations (and be able to do this at any level of nesting too)
<seafoodX>
Would anyone else here find that useful?
<Smerdyakov>
Sure.
<Smerdyakov>
But, you know what. Code written in a way that calls out for that is probably poorly designed.
<seafoodX>
I didn't write this code. But it brings up and interesting point. Do you mind if we talk about the tension between local functions and function size overall?
<Smerdyakov>
I don't mind, nosir.
<Smerdyakov>
Not like my opinion matters more than 1/58.
seafood has joined #ocaml
<seafoodX>
Okay, local functions have the advantage that they're encapsulated inside the parent function. But they take up space.
<seafoodX>
How many local functions is too many?
<seafoodX>
You can always factor them out but then you usually have to provide more parameters for them.
<Smerdyakov>
I tend to think that any recursive function is too many.
<seafoodX>
You don't like recursion?
<Smerdyakov>
Except for AST traversals
<Smerdyakov>
But, then, often for those, too.
<Smerdyakov>
I don't like explicit recursion in place of combinators.
<seafoodX>
I understand. There are many ways to factor out recursion into useful combinators.
<seafoodX>
But seriously, would you have a function that goes beyond say 40 lines ever?
<Smerdyakov>
I think that's probably bad, but I do it all the time.
<Smerdyakov>
I try to learn from such experiences and iterate with better versions.
<Smerdyakov>
I like to think that the fancy stuff I do in grad school is unrepresentative of the totality of programming, and most cases are easy to factor.
<seafoodX>
My problem with factoring out local functions is that then they're at the top-level. There doesn't seem to be a nice way to "group" these functions with where they are use except to create a new module and put them in there.
<seafoodX>
Maybe that's the way to go?
<Smerdyakov>
Modules are good. Details depend on the situation.
<seafoodX>
Wow, your advisor is George Necula :-)
<Smerdyakov>
So what. You have TWO advisors!
<seafoodX>
One's a co-supervisor :)
<Smerdyakov>
Going to ICFP'07?
<seafoodX>
Hey, if my paper to Haskell Workshop gets accepted, sure.
<seafoodX>
But it may not.
<Smerdyakov>
Man, you need to aim higher than that.
<Smerdyakov>
You have too many Haskell Workshop papers.
<Smerdyakov>
Oh, one you have listed is the submitted one.
<Smerdyakov>
2 is still too many. ;)
<seafoodX>
Smerdyakov: I "queried" you.
<Smerdyakov>
Yup, I assumed.
<Smerdyakov>
Oh.
<Smerdyakov>
You need to be authenticated to services to send private messages.
TFKv2 has quit [Read error: 110 (Connection timed out)]
<seafoodX>
Smerdyakov: What does that mean?
<Smerdyakov>
/msg nickserv help
shawn_ has joined #ocaml
Clintach_ has joined #ocaml
mauke has quit ["no bus no"]
Clintach has quit [Read error: 110 (Connection timed out)]
ulfdoz has quit [simmons.freenode.net irc.freenode.net]
benny has quit [simmons.freenode.net irc.freenode.net]
slipstream has quit [simmons.freenode.net irc.freenode.net]
jlouis_ has quit [simmons.freenode.net irc.freenode.net]
G has quit [simmons.freenode.net irc.freenode.net]
danly has quit [simmons.freenode.net irc.freenode.net]
oracle1 has quit [simmons.freenode.net irc.freenode.net]
fean has quit [simmons.freenode.net irc.freenode.net]
gim has quit [simmons.freenode.net irc.freenode.net]
oracle1 has joined #ocaml
gim has joined #ocaml
fean has joined #ocaml
ulfdoz has joined #ocaml
danly has joined #ocaml
G has joined #ocaml
jlouis_ has joined #ocaml
slipstream has joined #ocaml
benny has joined #ocaml
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
Mr_Awesome has quit ["time to impregnate a moth"]
shawn_ has quit [Read error: 113 (No route to host)]
slipstream has quit [Read error: 104 (Connection reset by peer)]
slipstream has joined #ocaml
shawn_ has joined #ocaml
np has joined #ocaml
shawn_ has quit [Remote closed the connection]
shawn_ has joined #ocaml
smimou has joined #ocaml
rwmjones has joined #ocaml
kelaouchi has quit [Client Quit]
rcy has left #ocaml []
clog has joined #ocaml
noteventime has joined #ocaml
astra has joined #ocaml
np has quit [Remote closed the connection]
astra has quit ["Leaving"]
edwardk has joined #ocaml
Lena has joined #ocaml
_blackdog has joined #ocaml
_blackdog has left #ocaml []
edwardk has left #ocaml []
pango has quit [Remote closed the connection]
pango has joined #ocaml
cjeris has joined #ocaml
Lena has quit [Read error: 110 (Connection timed out)]
ulfdoz has quit [heinlein.freenode.net irc.freenode.net]
jlouis_ has quit [heinlein.freenode.net irc.freenode.net]
oracle1 has quit [heinlein.freenode.net irc.freenode.net]
gim has quit [heinlein.freenode.net irc.freenode.net]
benny has quit [heinlein.freenode.net irc.freenode.net]
danly has quit [heinlein.freenode.net irc.freenode.net]
fean has quit [heinlein.freenode.net irc.freenode.net]
G has quit [heinlein.freenode.net irc.freenode.net]
oracle1 has joined #ocaml
gim has joined #ocaml
fean has joined #ocaml
ulfdoz has joined #ocaml
danly has joined #ocaml
G has joined #ocaml
jlouis_ has joined #ocaml
benny has joined #ocaml
piggybox has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
smimou has joined #ocaml
psnively has joined #ocaml
<psnively>
Howdy, folks!
<rwmjones>
hey
<psnively>
:-)
<rwmjones>
I'm trying to get LeCamarade's bot working, without much luck
<rwmjones>
but more seriously, trying to make it secure
<psnively>
LeCamarade?
<rwmjones>
afaics there is no way to invoke the ocaml toplevel securely, because there is no way to prevent someone doing external magic : 'a -> 'b = "%identity"
<psnively>
Taken a look at Emily?
<rwmjones>
psnively, he's the chap from uganda who was writing an IRC bot to interpret OCaml expressions for this chan
<flux>
rwmjones, I don't know if that can somehow be applied to the toplevel
<rwmjones>
exactly, &&&
<rwmjones>
^^^
<psnively>
rwmjones: Then I argue that object capability security is EXACTLY what you want.
<psnively>
And since we're talking about OCaml, Emily is exactly what you want.
<flux>
rwmjones, well, do the suggestions from the thread work?
* rwmjones
is reading that tech report
<rwmjones>
I'm not exactly sure how I'd apply that to the task at hand (given other constraints, like I want to get this workingin the next hour before my boss gets back from lunch)
xavierbot has joined #ocaml
<rwmjones>
rot13 this is a test of the Perl POE::Component::IRC rot13 script
<xavierbot>
rwmjones: guvf vf n grfg bs gur Crey CBR::Pbzcbarag::VEP ebg13 fpevcg
<psnively>
It's not realistic to build a safe sandboxed environment in an hour.
<flux>
invoke ocamlc -nopervasives -c incoming_source.ml, load the .cmo with Dynlink, while giving it a list of safe modules?
<rwmjones>
flux, that was where my thinking was going
<rwmjones>
however the bot would only be useful if it
<rwmjones>
prints out the value & type
<rwmjones>
hence toplevel territory
<flux>
ok
<flux>
is it possible to link toplevel in? and somehow gain that functionality?
<rwmjones>
it's not much use for the bot to merely execute the code :-)
<rwmjones>
yeah ... not sure
<psnively>
Do you really need it to print the type, though?
<flux>
merely executing stuff would be an interesting first-step
<psnively>
If you do, consider MetaOCaml and Oleg's generic print function.
<flux>
then there's this fork (?) on ocaml that provides type information on written expressions
<flux>
without evaluating them
<psnively>
But I'm still trying to figure out why, given an hour, downloading Emily and trying it isn't the fastest route.
slipstream-- has joined #ocaml
<flux>
rwmjones, btw, if you put module Pervasives = struct end, doesn't that mean that the module cannot anymore access the system's pervasives module..
<flux>
that is: prepend to the source
<flux>
it's ugly, but..
<rwmjones>
flux, yes I tried that too, but people can still define unsafe external functions as above
<flux>
rwmjones, oh, still thinking about the toplevel solution?
<rwmjones>
well ...
<flux>
rwmjones, hey, here's an idea: feed it through a camlp4 filter that bails out on unsafe constructs :-)
<flux>
(but I bet your one hour isn't enough for that..)
<rwmjones>
that is an idea ... I wonder if 'grep -v' is even easier
<flux>
I would trust a camlp4-based solution more..
<flux>
you might get false hits with grep -v
<flux>
but then again, for the first version, it might not matter
<rwmjones>
it's the false misses I'd be more worried about
<psnively>
Um, Emily already does this, guys.
* psnively
jumps up and down, waving arms.
<rwmjones>
I've got the code & I'm reading it
<psnively>
OK. :-)
<rwmjones>
still not sure what it does
<psnively>
Disallows some constructs (external, module-level refs, new exception types). Limits library access to only those functions that don't leak authority.
<psnively>
It's at least 90% of what you're looking for.
<rwmjones>
emily seems to allow me to compile a *.ml file, and be sure that it doesn't either do unsafe stuff or call some pervasives functions like open_in
<rwmjones>
but I don't understand how that gives me anything over
slipstream has quit [Read error: 110 (Connection timed out)]
<rwmjones>
ie, compiling and Dynlinking with the relevant options to prevent access to Pervasives, unsafe functions, and allow only access to my safe API functions
<rwmjones>
& it still doesn't help that I can't print out values & their type
<psnively>
Emily has already identified SafeAPI for the standard libraries, and also disallows unsafe language constructs.
<psnively>
Yeah, I think (in Emily terms) you'd have to figure out how to make the toplevel library part of your "powerbox" without totally subverting security. I'd punt on that.
<rwmjones>
an alternate approach is to chroot the process .....
<rwmjones>
run it as a different user, chroot it somewhere where it can't do much harm, and log everything
<flux>
well how do you prevent it from getting too much IPC shared memory?
<flux>
of course, perhaps by the fact that IPC shared memory isn't (?) provided by the ocaml standard library..
<flux>
but if you can perform arbitrary code, perhaps someone can find out a way..
<flux>
like by casting a string to ocaml function and calling it
<psnively>
Or by the safe library. Also, no "external" anything.
<rwmjones>
yeah, they can subvert the process alright if we give them access to an unfiltered toplevel
<flux>
what if you simply patch out the support for external function definitions from the source code
<psnively>
AFAICT, the toplevel is guaranteed to screw you over.
<flux>
shouldn't be too much of a job to find the code fragment and assert false it
<psnively>
That (and the lack of intrinsic language support for printing types) is why I'd give up on it.
<rwmjones>
camlp4 with lots of DELETE_RULEs might be a goer
<psnively>
You're rewriting Emily. :-D
* psnively
shuts up, already.
<rwmjones>
well ..... I've found through experiment that it is sufficient to have a -init file which defines a new, empty Pervasives module and overrides all the potentially harmful Pervasives functions
<rwmjones>
with chroot, I can prevent access to any other modules (except ones that I want)
<rwmjones>
and similarly I can prevent access to unsafe functions in other modules
<rwmjones>
that is, to some extent, rewriting what Emily does, perhaps the other way around (I'm definining a very small, tight core of functions that I allow)
<rwmjones>
the only remaining problem in the toplevel, afaics, is external defns
<rwmjones>
that gets it all, right?
<psnively>
Right. Seems that the key is disallowing unsafe language constructs, and knowing what stdlib functions are OK and not.
<psnively>
Another potential issue I see is that Emily is strictly native, not bytecode... so all you could do is run the results as a (fast?) CGI.
<rwmjones>
are there other unsafe constructs in the language?
<rwmjones>
apart from external
<psnively>
It depends upon at what granularity you're trying to impose security.
<psnively>
So I'm going to say: no.
<psnively>
Given that you're not attempting to impose capability security at the "object" level.
<rwmjones>
hmmm ... maybe I should code this & then let you lot try to exploit it
<psnively>
Heh. I make no special claim to cracker wizardry.
love-pingoo has joined #ocaml
<psnively>
If you really do know what your SafeAPI is, and you really do know how to expunge "external" from the language, I'd say, as far as "perimeter security" goes, you're probably well enough along the path (as far as I can tell).
ygrek has joined #ocaml
<flux>
rwmjones, it would be nicer if it didn't require a chroot with a separate user account - that way you wouldn't need root to set things up
<rwmjones>
flux, yup
<rwmjones>
I think I'm on to something now ... just creating my DELETE_RULE to get rid of the "external" keyword ... it's a race against the clock .....
* rwmjones
wishes they'd document the new camlp4 ...
piggybox has quit [Nick collision from services.]
piggybox5 has joined #ocaml
<psnively>
I ended up rolling back to 3.09.3 for now.
piggybox5 is now known as piggybox
piggybox has quit [Nick collision from services.]
piggybox5 has joined #ocaml
<rwmjones>
hey ... works
<rwmjones>
$ ocaml -I +camlp4
<rwmjones>
Objective Caml version 3.10.0
<rwmjones>
# #load "camlp4o.cmo";;
<rwmjones>
Cannot find file camlp4o.cmo.
<rwmjones>
# #load "camlp4o.cma";;
<rwmjones>
Camlp4 Parsing version 3.10.0
<rwmjones>
# #load "pa_noexternal.cmo";;
<rwmjones>
# external magic : 'a -> 'b = "%identity";;
<rwmjones>
# magic;;
<rwmjones>
Unbound value magic
piggybox has joined #ocaml
piggybox5 has quit [Connection timed out]
<psnively>
Nice.
shawn_ has quit [Read error: 110 (Connection timed out)]
<flux>
rwmjones, did you meed the deadline?-)
<flux>
s/meed/meet/
<psnively>
He might enjoy some mead after his deadline. :-D
xavierbot has quit [Remote closed the connection]
<rwmjones>
no, I got to do some work, but it's coming along nicely
<psnively>
Hmmm. Should you make "external" a syntax error, or just not have it bind its target?
<psnively>
And yeah, to me, the hard part seems to be ensuring the safety of the libraries you allow to be used.
pants1 has quit ["Leaving."]
malc_ has joined #ocaml
piggybox has quit [Nick collision from services.]
piggybox5 has joined #ocaml
david_koontz has joined #ocaml
piggybox5 is now known as piggybox
TFK has quit []
_blackdog has joined #ocaml
xavierbot has joined #ocaml
<rwmjones>
let f () = print_endline "hello, world";;
<xavierbot>
# val f : unit -> unit = <fun>
<rwmjones>
f ();;
<xavierbot>
# hello, world
<xavierbot>
- : unit = ()
<rwmjones>
hmm, that extra # char is a bit annoying, seems to come from the prompt
<rwmjones>
let range a b = if a < b then a :: range (a+1) b else [] ;;
<xavierbot>
# Characters 36-41:
<xavierbot>
let range a b = if a < b then a :: range (a+1) b else [] ;;
<xavierbot>
^^^^^
<xavierbot>
Unbound value range
<rwmjones>
let rec range a b = if a < b then a :: range (a+1) b else [] ;;
<xavierbot>
# val range : int -> int -> int list = <fun>
<rwmjones>
range 1 10;;
<xavierbot>
# - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9]
<rwmjones>
let rec range a b = if a <= b then a :: range (a+1) b else [] ;;
<xavierbot>
# val range : int -> int -> int list = <fun>
<rwmjones>
range 1 10;;
<xavierbot>
# - : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
<rwmjones>
external magic : 'a -> 'b = "%identity";;
<xavierbot>
# 'external' keyword disabled
<xavierbot>
- : unit = ()
<rwmjones>
magic;;
<xavierbot>
# Characters 1-6:
<xavierbot>
magic;;
<xavierbot>
^^^^^
<xavierbot>
Unbound value magic
<rwmjones>
let chan = open_in "/etc/passwd";;
<xavierbot>
# Characters 12-19:
<xavierbot>
let chan = open_in "/etc/passwd";;
<xavierbot>
^^^^^^^
<xavierbot>
This expression is not a function, it cannot be applied
<rwmjones>
module U = Unix;;
<xavierbot>
# module U : sig end
<rwmjones>
module O = Obj;;
<xavierbot>
# Characters 12-15:
<xavierbot>
module O = Obj;;
<xavierbot>
^^^
<xavierbot>
Unbound module Obj
<rwmjones>
module S = String;;
<xavierbot>
# module S :
<xavierbot>
sig
<xavierbot>
external length : string -> int = "%string_length"
<xavierbot>
external get : string -> int -> char = "%string_safe_get"
<xavierbot>
external set : string -> int -> char -> unit = "%string_safe_set"
<xavierbot>
external create : int -> string = "caml_create_string"
<xavierbot>
val make : int -> char -> string
<xavierbot>
val copy : string -> string
<xavierbot>
val sub : string -> int -> int -> string
<xavierbot>
val fill : string -> int -> int -> char -> unit
<xavierbot>
val blit : string -> int -> string -> int -> int -> unit
<xavierbot>
val concat : string -> string list -> string
<xavierbot>
val iter : (char -> unit) -> string -> unit
<xavierbot>
val escaped : string -> string
<xavierbot>
val index : string -> char -> int
<xavierbot>
val rindex : string -> char -> int
<xavierbot>
val index_from : string -> int -> char -> int
<xavierbot>
val rindex_from : string -> int -> char -> int
<xavierbot>
val contains : string -> char -> bool
<xavierbot>
val contains_from : string -> int -> char -> bool
<xavierbot>
val rcontains_from : string -> int -> char -> bool
<xavierbot>
val uppercase : string -> string
<xavierbot>
val lowercase : string -> string
<xavierbot>
val capitalize : string -> string
<xavierbot>
val uncapitalize : string -> string
<xavierbot>
type t = string
<xavierbot>
val compare : t -> t -> int
<xavierbot>
end
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
let hello () = print_endline "hello, world";;
<xavierbot>
val hello : unit -> unit = <fun>
<rwmjones>
hello ();;
<xavierbot>
hello, world
<xavierbot>
- : unit = ()
<rwmjones>
got rid of that prompt now
<psnively>
Cool.
<rwmjones>
psnively, please feel free to play
* rwmjones
wonders exactly how annoyed xleroy will get if I announce this on caml-list
<psnively>
Hmmm,
<psnively>
Why would he be annoyed? Because it's named after him?
<ygrek>
hm... Sys.execute "rm -rf ~" ?
<rwmjones>
Sys.execute "rm -rf ~";;
<xavierbot>
Characters 1-12:
<xavierbot>
Sys.execute "rm -rf ~";;
<xavierbot>
^^^^^^^^^^^
<xavierbot>
Unbound value Sys.execute
<cjeris>
rwmjones: what does it trigger on? a terminal ;; ?
<rwmjones>
I've only included a few functions from Pervasives, all of List, and some of String
<rwmjones>
terminal ;;
<xavierbot>
Characters 1-9:
<xavierbot>
terminal ;;
<xavierbot>
^^^^^^^^
<xavierbot>
Unbound value terminal
<rwmjones>
as you can see :-)
ygrek has quit []
<cjeris>
;;
<rwmjones>
it has to be non-empty stmt
<cjeris>
;;;
<xavierbot>
Characters 1-3:
<xavierbot>
Parse error: illegal begin of top_phrase
<xavierbot>
;;;
<xavierbot>
^^
<rwmjones>
it matches this regexp:
<rwmjones>
if (my ($stmt) = $what =~ /^\s*([^#].*;;)\s*$/) {
<rwmjones>
with the idea that you can't send #commands like #load
<psnively>
let foo = "" ref;;
<xavierbot>
Characters 11-13:
<xavierbot>
let foo = "" ref;;
<xavierbot>
^^
<xavierbot>
This expression is not a function, it cannot be applied
<rwmjones>
not that it would do much coz it's chrooted into an empty directory, but better safe than sorry
<rwmjones>
let foo = ref "";;
<xavierbot>
val foo : string ref = {contents = ""}
<rwmjones>
foo := "hello";;
<psnively>
let foo = ref "";
<xavierbot>
- : unit = ()
<psnively>
Yeah.
<psnively>
Hmmm.
<rwmjones>
we're all writing to the same toplevel
<psnively>
foo := Obj.magic(1);;
<xavierbot>
Characters 8-17:
<xavierbot>
foo := Obj.magic(1);;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value Obj.magic
<psnively>
open Obj;;
<xavierbot>
Characters 1-9:
<xavierbot>
open Obj;;
<xavierbot>
^^^^^^^^
<xavierbot>
Unbound module Obj
<psnively>
Heh.
<rwmjones>
should only be a few Pervasives funcs, List and String available, and the Pervasives module itself isn't available
* rwmjones
packages up the source ...
<cjeris>
module type GRAPH = sig type ('v, 'e) t val make: 'v list -> ('v * 'v * 'e) list -> ('v, 'e) t val vertices: ('v, 'e) t -> 'v list val edges: ('v, 'e) t -> ('v * 'v * 'e) list val neighbors: ('v, 'e) t -> 'v -> 'v list val dfs: ('v, 'e) t -> 'v -> 'v -> 'v list option end
<cjeris>
oops, forgot the ...
<cjeris>
module type GRAPH = sig type ('v, 'e) t val make: 'v list -> ('v * 'v * 'e) list -> ('v, 'e) t val vertices: ('v, 'e) t -> 'v list val edges: ('v, 'e) t -> ('v * 'v * 'e) list val neighbors: ('v, 'e) t -> 'v -> 'v list val dfs: ('v, 'e) t -> 'v -> 'v -> 'v list option end;;
<xavierbot>
module type GRAPH =
<xavierbot>
sig
<xavierbot>
type ('a, 'b) t
<xavierbot>
val make : 'a list -> ('a * 'a * 'b) list -> ('a, 'b) t
<xavierbot>
val vertices : ('a, 'b) t -> 'a list
<xavierbot>
val edges : ('a, 'b) t -> ('a * 'a * 'b) list
<xavierbot>
val neighbors : ('a, 'b) t -> 'a -> 'a list
<xavierbot>
val dfs : ('a, 'b) t -> 'a -> 'a -> 'a list option