libvirt/tests/object-locking.ml
Daniel P. Berrange 07a6b9aac4 Rename 'DeviceMonitor' to 'NodeDeviceDriver'
The driver.h struct for node devices used an inconsistent
naming scheme 'DeviceMonitor' instead of the more usual
'NodeDeviceDriver'. Fix this everywhere it has leaked
out to.

Signed-off-by: Daniel P. Berrange <berrange@redhat.com>
2013-04-24 10:59:53 +01:00

829 lines
23 KiB
OCaml

(*
* Analyse libvirt driver API methods for mutex locking mistakes
*
* Copyright (C) 2008-2010, 2012 Red Hat, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library. If not, see
* <http://www.gnu.org/licenses/>.
*
* Author: Daniel P. Berrange <berrange@redhat.com>
*)
open Pretty
open Cil
(*
* Convenient routine to load the contents of a file into
* a list of strings
*)
let input_file filename =
let chan = open_in filename in
let lines = ref [] in
try while true; do lines := input_line chan :: !lines done; []
with
End_of_file -> close_in chan; List.rev !lines
module DF = Dataflow
module UD = Usedef
module IH = Inthash
module E = Errormsg
module VS = UD.VS
let debug = ref false
let driverTables = [
"virDriver";
"virNetworkDriver";
"virStorageDriver";
"virNodeDeviceDriver";
(* "virStateDriver"; Disable for now, since shutdown/startup have weird locking rules *)
]
(*
* This is the list of all libvirt methods which return
* pointers to locked objects
*)
let lockedObjMethods = [
"virDomainFindByID";
"virDomainFindByUUID";
"virDomainFindByName";
"virDomainAssignDef";
"virNetworkFindByUUID";
"virNetworkFindByName";
"virNetworkAssignDef";
"virNodeDeviceFindByName";
"virNodeDeviceAssignDef";
"virStoragePoolObjFindByUUID";
"virStoragePoolObjFindByName";
"virStoragePoolObjAssignDef"
]
(*
* This is the list of all libvirt methods which
* can release an object lock. Technically we
* ought to pair them up correctly with previous
* ones, but the compiler can already complain
* about passing a virNetworkObjPtr to a virDomainObjUnlock
* method so lets be lazy
*)
let objectLockMethods = [
"virDomainObjLock";
"virNetworkObjLock";
"virStoragePoolObjLock";
"virNodeDevObjLock"
]
(*
* This is the list of all libvirt methods which
* can release an object lock. Technically we
* ought to pair them up correctly with previous
* ones, but the compiler can already complain
* about passing a virNetworkObjPtr to a virDomainObjUnlock
* method so lets be lazy
*)
let objectUnlockMethods = [
"virDomainObjUnlock";
"virNetworkObjUnlock";
"virStoragePoolObjUnlock";
"virNodeDevObjUnlock"
]
(*
* The data types that the previous two sets of
* methods operate on
*)
let lockableObjects = [
"virDomainObjPtr";
"virNetworkObjPtr";
"virStoragePoolObjPtr";
"virNodeDevObjPtr"
]
(*
* The methods which globally lock an entire driver
*)
let driverLockMethods = [
"qemuDriverLock";
"openvzDriverLock";
"testDriverLock";
"lxcDriverLock";
"umlDriverLock";
"nodedevDriverLock";
"networkDriverLock";
"storageDriverLock";
"oneDriverLock"
]
(*
* The methods which globally unlock an entire driver
*)
let driverUnlockMethods = [
"qemuDriverUnlock";
"openvzDriverUnlock";
"testDriverUnlock";
"lxcDriverUnlock";
"umlDriverUnlock";
"nodedevDriverUnlock";
"networkDriverUnlock";
"storageDriverUnlock";
"oneDriverUnlock"
]
(*
* The data types that the previous two sets of
* methods operate on. These may be structs or
* typedefs, we don't care
*)
let lockableDrivers = [
"qemud_driver";
"openvz_driver";
"testConnPtr";
"lxc_driver_t";
"uml_driver";
"virStorageDriverStatePtr";
"network_driver";
"virNodeDeviceState";
"one_driver_t";
]
let isFuncCallLval lval methodList =
match lval with
Var vi, o ->
List.mem vi.vname methodList
| _ -> false
let isFuncCallExp exp methodList =
match exp with
Lval lval ->
isFuncCallLval lval methodList
| _ -> false
let isFuncCallInstr instr methodList =
match instr with
Call (retval,exp,explist,srcloc) ->
isFuncCallExp exp methodList
| _ -> false
let findDriverFunc init =
match init with
SingleInit (exp) -> (
match exp with
AddrOf (lval) -> (
match lval with
Var vi, o ->
true
| _ -> false
)
| _ -> false
)
| _ ->false
let findDriverFuncs init =
match init with
CompoundInit (typ, list) ->
List.filter (
fun l ->
match l with
(offset, init) ->
findDriverFunc init
) list;
| _ -> ([])
let getDriverFuncs initinfo =
match initinfo.init with
Some (i) ->
let ls = findDriverFuncs i in
ls
| _ -> []
let getDriverFuncName init =
match init with
SingleInit (exp) -> (
match exp with
AddrOf (lval) -> (
match lval with
Var vi, o ->
vi.vname
| _ -> "unknown"
)
| _ -> "unknown"
)
| _ -> "unknown"
let getDriverFuncNames initinfo =
List.map (
fun l ->
match l with
(offset, init) ->
getDriverFuncName init
) (getDriverFuncs initinfo)
(*
* Convenience methods which take a Cil.Instr object
* and ask whether its associated with one of the
* method sets defined earlier
*)
let isObjectFetchCall instr =
isFuncCallInstr instr lockedObjMethods
let isObjectLockCall instr =
isFuncCallInstr instr objectLockMethods
let isObjectUnlockCall instr =
isFuncCallInstr instr objectUnlockMethods
let isDriverLockCall instr =
isFuncCallInstr instr driverLockMethods
let isDriverUnlockCall instr =
isFuncCallInstr instr driverUnlockMethods
let isWantedType typ typeList =
match typ with
TNamed (tinfo, attrs) ->
List.mem tinfo.tname typeList
| TPtr (ptrtyp, attrs) ->
let f = match ptrtyp with
TNamed (tinfo2, attrs) ->
List.mem tinfo2.tname typeList
| TComp (cinfo, attrs) ->
List.mem cinfo.cname typeList
| _ ->
false in
f
| _ -> false
(*
* Convenience methods which take a Cil.Varinfo object
* and ask whether it matches a variable datatype that
* we're interested in tracking for locking purposes
*)
let isLockableObjectVar varinfo =
isWantedType varinfo.vtype lockableObjects
let isLockableDriverVar varinfo =
isWantedType varinfo.vtype lockableDrivers
let isDriverTable varinfo =
isWantedType varinfo.vtype driverTables
(*
* Take a Cil.Exp object (ie an expression) and see whether
* the expression corresponds to a check for NULL against
* one of our interesting objects
* eg
*
* if (!vm) ...
*
* For a variable 'virDomainObjPtr vm'
*)
let isLockableThingNull exp funcheck =
match exp with
| UnOp (op,exp,typ) -> (
match op with
LNot -> (
match exp with
Lval (lhost, off) -> (
match lhost with
Var vi ->
funcheck vi
| _ -> false
)
| _ -> false
)
| _ -> false
)
| _ ->
false
let isLockableObjectNull exp =
isLockableThingNull exp isLockableObjectVar
let isLockableDriverNull exp =
isLockableThingNull exp isLockableDriverVar
(*
* Prior to validating a function, initialize these
* to VS.empty
*
* They contain the list of driver and object variables
* objects declared as local variables
*
*)
let lockableObjs: VS.t ref = ref VS.empty
let lockableDriver: VS.t ref = ref VS.empty
(*
* Given a Cil.Instr object (ie a single instruction), get
* the list of all used & defined variables associated with
* it. Then caculate intersection with the driver and object
* variables we're interested in tracking and return four sets
*
* List of used driver variables
* List of defined driver variables
* List of used object variables
* List of defined object variables
*)
let computeUseDefState i =
let u, d = UD.computeUseDefInstr i in
let useo = VS.inter u !lockableObjs in
let defo = VS.inter d !lockableObjs in
let used = VS.inter u !lockableDriver in
let defd = VS.inter d !lockableDriver in
(used, defd, useo, defo)
(* Some crude helpers for debugging this horrible code *)
let printVI vi =
ignore(printf " | %a %s\n" d_type vi.vtype vi.vname)
let printVS vs =
VS.iter printVI vs
let prettyprint2 stmdat () (_, ld, ud, lo, ui, uud, uuo, loud, ldlo, dead) =
text ""
type ilist = Cil.instr list
(*
* This module implements the Cil.DataFlow.ForwardsTransfer
* interface. This is what 'does the interesting stuff'
* when walking over a function's code paths
*)
module Locking = struct
let name = "Locking"
let debug = debug
(*
* Our state currently consists of
*
* The set of driver variables that are locked
* The set of driver variables that are unlocked
* The set of object variables that are locked
* The set of object variables that are unlocked
*
* Lists of Cil.Instr for:
*
* Instrs using an unlocked driver variable
* Instrs using an unlocked object variable
* Instrs locking a object variable while not holding a locked driver variable
* Instrs locking a driver variable while holding a locked object variable
* Instrs causing deadlock by fetching a lock object, while an object is already locked
*
*)
type t = (unit * VS.t * VS.t * VS.t * VS.t * ilist * ilist * ilist * ilist * ilist)
(* This holds an instance of our state data, per statement *)
let stmtStartData = IH.create 32
let pretty =
prettyprint2 stmtStartData
let copy (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
((), ld, ud, lo, uo, uud, uuo, loud, ldlo, dead)
let computeFirstPredecessor stm (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
((), ld, ud, lo, uo, uud, uuo, loud, ldlo, dead)
(*
* Merge existing state for a statement, with new state
*
* If new and old state is the same, this returns None,
* If they are different, then returns the union.
*)
let combinePredecessors (stm:stmt) ~(old:t) ((_, ldn, udn, lon, uon, uudn, uuon, loudn, ldlon, deadn):t) =
match old with (_, ldo, udo, loo,uoo, uudo, uuoo, loudo, ldloo, deado)-> begin
let lde= (VS.equal ldo ldn) || ((VS.is_empty ldo) && (VS.is_empty ldn)) in
let ude= VS.equal udo udn || ((VS.is_empty udo) && (VS.is_empty udn)) in
let loe= VS.equal loo lon || ((VS.is_empty loo) && (VS.is_empty lon)) in
let uoe= VS.equal uoo uon || ((VS.is_empty uoo) && (VS.is_empty uon)) in
if lde && ude && loe && uoe then
None
else (
let ldret = VS.union ldo ldn in
let udret = VS.union udo udn in
let loret = VS.union loo lon in
let uoret = VS.union uoo uon in
Some ((), ldret, udret, loret, uoret, uudn, uuon, loudn, ldlon, deadn)
)
end
(*
* This handles a Cil.Instr object. This is sortof a C level statement.
*)
let doInstr i (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
let transform (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
let used, defd, useo, defo = computeUseDefState i in
if isDriverLockCall i then (
(*
* A driver was locked, so add to the list of locked
* driver variables, and remove from the unlocked list
*)
let retld = VS.union ld used in
let retud = VS.diff ud used in
(*
* Report if any objects are locked already since
* thats a deadlock risk
*)
if VS.is_empty lo then
((), retld, retud, lo, uo, uud, uuo, loud, ldlo, dead)
else
((), retld, retud, lo, uo, uud, uuo, loud, List.append ldlo [i], dead)
) else if isDriverUnlockCall i then (
(*
* A driver was unlocked, so add to the list of unlocked
* driver variables, and remove from the locked list
*)
let retld = VS.diff ld used in
let retud = VS.union ud used in
((), retld, retud, lo, uo, uud, uuo, loud, ldlo, dead);
) else if isObjectFetchCall i then (
(*
* A object was fetched & locked, so add to the list of
* locked driver variables. Nothing to remove from unlocked
* list here.
*
* XXX, not entirely true. We should check if they're
* blowing away an existing non-NULL value in the lval
* really.
*)
let retlo = VS.union lo defo in
(*
* Report if driver is not locked, since that's a safety
* risk
*)
if VS.is_empty ld then (
if VS.is_empty lo then (
((), ld, ud, retlo, uo, uud, uuo, List.append loud [i], ldlo, dead)
) else (
((), ld, ud, retlo, uo, uud, uuo, List.append loud [i], ldlo, List.append dead [i])
)
) else (
if VS.is_empty lo then (
((), ld, ud, retlo, uo, uud, uuo, loud, ldlo, dead)
) else (
((), ld, ud, retlo, uo, uud, uuo, loud, ldlo, List.append dead [i])
)
)
) else if isObjectLockCall i then (
(*
* A driver was locked, so add to the list of locked
* driver variables, and remove from the unlocked list
*)
let retlo = VS.union lo useo in
let retuo = VS.diff uo useo in
(*
* Report if driver is not locked, since that's a safety
* risk
*)
if VS.is_empty ld then
((), ld, ud, retlo, retuo, uud, uuo, List.append loud [i], ldlo, dead)
else
((), ld, ud, retlo, retuo, uud, uuo, loud, ldlo, dead)
) else if isObjectUnlockCall i then (
(*
* A object was unlocked, so add to the list of unlocked
* driver variables, and remove from the locked list
*)
let retlo = VS.diff lo useo in
let retuo = VS.union uo useo in
((), ld, ud, retlo, retuo, uud, uuo, loud, ldlo, dead);
) else (
(*
* Nothing special happened, at best an assignment.
* So add any defined variables to the list of unlocked
* object or driver variables.
* XXX same edge case as isObjectFetchCall about possible
* overwriting
*)
let retud = VS.union ud defd in
let retuo = VS.union uo defo in
(*
* Report is a driver is used while unlocked
*)
let retuud =
if not (VS.is_empty used) && (VS.is_empty ld) then
List.append uud [i]
else
uud in
(*
* Report is a object is used while unlocked
*)
let retuuo =
if not (VS.is_empty useo) && (VS.is_empty lo) then
List.append uuo [i]
else
uuo in
((), ld, retud, lo, retuo, retuud, retuuo, loud, ldlo, dead)
);
in
DF.Post transform
(*
* This handles a Cil.Stmt object. This is sortof a C code block
*)
let doStmt stm (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
DF.SUse ((), ld, ud, lo, uo, [], [], [], [], [])
(*
* This handles decision making for a conditional statement,
* ie an if (foo). It is called twice for each conditional
* ie, once per possible choice.
*)
let doGuard exp (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
(*
* If we're going down a branch where our object variable
* is set to NULL, then we must remove it from the
* list of locked objects. This handles the case of...
*
* vm = virDomainFindByUUID(..)
* if (!vm) {
* .... this code branch ....
* } else {
* .... leaves default handling for this branch ...
* }
*)
let lonull = UD.computeUseExp exp in
let loret =
if isLockableObjectNull exp then
VS.diff lo lonull
else
lo in
let uoret =
if isLockableObjectNull exp then
VS.union uo lonull
else
uo in
let ldret =
if isLockableDriverNull exp then
VS.diff ld lonull
else
ld in
let udret =
if isLockableDriverNull exp then
VS.union ud lonull
else
ud in
DF.GUse ((), ldret, udret, loret, uoret, uud, uuo, loud, ldlo, dead)
(*
* We're not filtering out any statements
*)
let filterStmt stm = true
end
module L = DF.ForwardsDataFlow(Locking)
let () =
(* Read the list of files from "libvirt-files". *)
let files = input_file "object-locking-files.txt" in
(* Load & parse each input file. *)
let files =
List.map (
fun filename ->
(* Why does parse return a continuation? *)
let f = Frontc.parse filename in
f ()
) files in
(* Merge them. *)
let file = Mergecil.merge files "test" in
(* Do control-flow-graph analysis. *)
Cfg.computeFileCFG file;
print_endline "";
let driverVars = List.filter (
function
| GVar (varinfo, initinfo, loc) -> (* global variable *)
let name = varinfo.vname in
if isDriverTable varinfo then
true
else
false
| _ -> false
) file.globals in
let driverVarFuncs = List.map (
function
| GVar (varinfo, initinfo, loc) -> (* global variable *)
let name = varinfo.vname in
if isDriverTable varinfo then
getDriverFuncNames initinfo
else
[]
| _ -> []
) driverVars in
let driverFuncsAll = List.flatten driverVarFuncs in
let driverFuncsSkip = [
"testClose";
"openvzClose";
] in
let driverFuncs = List.filter (
fun st ->
if List.mem st driverFuncsSkip then
false
else
true
) driverFuncsAll in
(*
* Now comes our fun.... iterate over every global symbol
* definition Cfg found..... but...
*)
List.iter (
function
(* ....only care about functions *)
| GFun (fundec, loc) -> (* function definition *)
let name = fundec.svar.vname in
if List.mem name driverFuncs then (
(* Initialize list of driver & object variables to be empty *)
ignore (lockableDriver = ref VS.empty);
ignore (lockableObjs = ref VS.empty);
(*
* Query all local variables, and figure out which correspond
* to interesting driver & object variables we track
*)
List.iter (
fun var ->
if isLockableDriverVar var then
lockableDriver := VS.add var !lockableDriver
else if isLockableObjectVar var then
lockableObjs := VS.add var !lockableObjs;
) fundec.slocals;
List.iter (
fun gl ->
match gl with
GVar (vi, ii, loc) ->
if isLockableDriverVar vi then
lockableDriver := VS.add vi !lockableDriver
| _ -> ()
) file.globals;
(*
* Initialize the state for each statement (ie C code block)
* to be empty
*)
List.iter (
fun st ->
IH.add Locking.stmtStartData st.sid ((),
VS.empty, VS.empty, VS.empty, VS.empty,
[], [], [], [], [])
) fundec.sallstmts;
(*
* This walks all the code paths in the function building
* up the state for each statement (ie C code block)
* ie, this is invoking the "Locking" module we created
* earlier
*)
L.compute fundec.sallstmts;
(*
* Find all statements (ie C code blocks) which have no
* successor statements. This means they are exit points
* in the function
*)
let exitPoints = List.filter (
fun st ->
List.length st.succs = 0
) fundec.sallstmts in
(*
* For each of the exit points, check to see if there are
* any with locked driver or object variables & grab them
*)
let leaks = List.filter (
fun st ->
let (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
IH.find Locking.stmtStartData st.sid in
let leakDrivers = not (VS.is_empty ld) in
let leakObjects = not (VS.is_empty lo) in
leakDrivers or leakObjects
) exitPoints in
let mistakes = List.filter (
fun st ->
let (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
IH.find Locking.stmtStartData st.sid in
let lockDriverOrdering = (List.length ldlo) > 0 in
let lockObjectOrdering = (List.length loud) > 0 in
let useDriverUnlocked = (List.length uud) > 0 in
let useObjectUnlocked = (List.length uuo) > 0 in
let deadLocked = (List.length dead) > 0 in
lockDriverOrdering or lockObjectOrdering or useDriverUnlocked or useObjectUnlocked or deadLocked
) fundec.sallstmts in
if (List.length leaks) > 0 || (List.length mistakes) > 0 then (
print_endline "================================================================";
ignore (printf "Function: %s\n" name);
print_endline "----------------------------------------------------------------";
ignore (printf " - Total exit points with locked vars: %d\n" (List.length leaks));
(*
* Finally tell the user which exit points had locked varaibles
* And show them the line number and code snippet for easy fixing
*)
List.iter (
fun st ->
ignore (Pretty.printf " - At exit on %a\n^^^^^^^^^\n" d_stmt st);
let (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
IH.find Locking.stmtStartData st.sid in
print_endline " variables still locked are";
printVS ld;
printVS lo
) leaks;
ignore (printf " - Total blocks with lock ordering mistakes: %d\n" (List.length mistakes));
List.iter (
fun st ->
let (_, ld, ud, lo, uo, uud, uuo, loud, ldlo, dead) =
IH.find Locking.stmtStartData st.sid in
List.iter (
fun i ->
ignore (Pretty.printf " - Driver locked while object is locked on %a\n" d_instr i);
) ldlo;
List.iter (
fun i ->
ignore (Pretty.printf " - Object locked while driver is unlocked on %a\n" d_instr i);
) loud;
List.iter (
fun i ->
ignore (Pretty.printf " - Driver used while unlocked on %a\n" d_instr i);
) uud;
List.iter (
fun i ->
ignore (Pretty.printf " - Object used while unlocked on %a\n" d_instr i);
) uuo;
List.iter (
fun i ->
ignore (Pretty.printf " - Object fetched while locked objects exist %a\n" d_instr i);
) dead;
) mistakes;
print_endline "================================================================";
print_endline "";
print_endline "";
);
()
)
| _ -> ()
) file.globals;