# HG changeset patch
# User David Scott <dave.scott@xxxxxxxxxxxxx>
# Date 1279903578 -3600
# Node ID 815d0a9b3661be23e76be25b95e9b0d7fd9641c9
# Parent 5f9ab87260fcdad5df85ce576d019690adbd67b5
First cut at a 'tapctl' module which wraps the 'tap-ctl' command
(Original version by Jon Ludlam <jonathan.ludlam@xxxxxxxxxxxxx>)
Signed-off-by: David Scott <dave.scott@xxxxxxxxxxxxx>
diff -r 5f9ab87260fc -r 815d0a9b3661 Makefile.in
--- a/Makefile.in Thu Jul 22 15:37:45 2010 +0100
+++ b/Makefile.in Fri Jul 23 17:46:18 2010 +0100
@@ -45,6 +45,7 @@
$(MAKE) -C eventchn
$(MAKE) -C cpuid
$(MAKE) -C vhd
+ $(MAKE) -C tapctl
endif
install:
@@ -84,6 +85,7 @@
$(MAKE) -C eventchn install
$(MAKE) -C cpuid install
$(MAKE) -C vhd install
+ $(MAKE) -C tapctl install
endif
uninstall:
@@ -123,6 +125,7 @@
$(MAKE) -C mmap uninstall
$(MAKE) -C cpuid uninstall
$(MAKE) -C vhd uninstall
+ $(MAKE) -C tapctl uninstall
endif
bins:
@@ -173,6 +176,7 @@
$(MAKE) -C mlvm doc
$(MAKE) -C cpuid doc
$(MAKE) -C vhd doc
+ $(MAKE) -C tapctl doc
$(MAKE) -C xen-utils doc
.PHONY: clean
@@ -195,6 +199,7 @@
$(MAKE) -C mlvm clean
$(MAKE) -C cpuid clean
$(MAKE) -C vhd clean
+ $(MAKE) -C tapctl clean
$(MAKE) -C xen-utils clean
cleanxen:
diff -r 5f9ab87260fc -r 815d0a9b3661 tapctl/META.in
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tapctl/META.in Fri Jul 23 17:46:18 2010 +0100
@@ -0,0 +1,5 @@
+version = "@VERSION@"
+description = "tapctl ocaml interface"
+requires = "unix,stdext,rpc-light.json"
+archive(byte) = "tapctl.cma"
+archive(native) = "tapctl.cmxa"
diff -r 5f9ab87260fc -r 815d0a9b3661 tapctl/Makefile
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tapctl/Makefile Fri Jul 23 17:46:18 2010 +0100
@@ -0,0 +1,68 @@
+CC = gcc
+CFLAGS = -Wall -fPIC -O2 -I/usr/lib/ocaml
+OCAMLC = ocamlc -g
+OCAMLOPT = ocamlopt
+
+FEPP = camlp4o -I ../rpc-light -I $(shell ocamlfind query type-conv)
pa_type_conv.cmo pa_rpc.cma
+
+LDFLAGS = -cclib -L./
+
+VERSION := $(shell hg parents --template "{rev}" 2>/dev/null || echo 0.0)
+OCAMLOPTFLAGS = -g -dtypes
+
+OCAMLABI := $(shell ocamlc -version)
+OCAMLLIBDIR := $(shell ocamlc -where)
+OCAMLDESTDIR ?= $(OCAMLLIBDIR)
+
+OBJS = tapctl
+INTF = $(foreach obj, $(OBJS),$(obj).cmi)
+LIBS = tapctl.cma tapctl.cmxa
+
+DOCDIR = /myrepos/xen-api-libs.hg/doc
+
+OCAMLFLAGS = -pp '${FEPP}' -I ../rpc-light -I ../stdext
+
+
+all: $(INTF) $(LIBS) $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+libs: $(LIBS)
+
+tapctl.cmxa: $(foreach obj,$(OBJS),$(obj).cmx)
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLFLAGS) -a -o $@ $(foreach
obj,$(OBJS),$(obj).cmx)
+
+tapctl.cma: $(foreach obj,$(OBJS),$(obj).cmo)
+ $(OCAMLC) $(OCAMLOPTFLAGS) $(OCAMLFLAGS) -a -o $@ $(foreach
obj,$(OBJS),$(obj).cmo)
+
+%.cmo: %.ml
+ $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
+
+%.cmi: %.mli
+ $(OCAMLC) $(OCAMLFLAGS) -c -o $@ $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) $(OCAMLFLAGS) -c -o $@ $<
+
+%.o: %.c
+ $(CC) $(CFLAGS) -c -o $@ $<
+
+META: META.in
+ sed 's/@VERSION@/$(VERSION)/g' < $< > $@
+
+.PHONY: install
+install: path = $(DESTDIR)$(shell ocamlfind printconf destdir)
+install: $(LIBS) META
+ mkdir -p $(path)
+ ocamlfind install -destdir $(path) -ldconf ignore tapctl META $(INTF)
$(LIBS) *.a *.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove tapctl
+
+.PHONY: doc
+doc: $(INTF)
+ python ../doc/doc.py $(DOCDIR) "tapctl" "package" "$(OBJS)" "." "" ""
+
+clean:
+ rm -f *.o *.so *.a *.cmo *.cmi *.cma *.cmx *.cmxa *.annot $(LIBS)
$(PROGRAMS)
diff -r 5f9ab87260fc -r 815d0a9b3661 tapctl/tapctl.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tapctl/tapctl.ml Fri Jul 23 17:46:18 2010 +0100
@@ -0,0 +1,130 @@
+open Stringext
+open Listext
+open Threadext
+open Forkhelpers
+
+type tapdev = {
+ minor : int;
+ tapdisk_pid : int;
+} with rpc
+
+type t = tapdev * string * (string * string) option
+
+type context = {
+ host_local_dir: string;
+ dummy: bool;
+}
+
+let create () = { host_local_dir = ""; dummy = false }
+
+let get_devnode_dir ctx =
+ let d = Printf.sprintf "%s/dev/xen/blktap-2" ctx.host_local_dir in
+ Unixext.mkdir_rec d 0o755;
+ d
+let get_blktapstem ctx = Printf.sprintf "%s/dev/xen/blktap-2/blktap"
ctx.host_local_dir
+let get_tapdevstem ctx = Printf.sprintf "%s/dev/xen/blktap-2/tapdev"
ctx.host_local_dir
+
+type driver = | Vhd | Aio
+
+let string_of_driver = function
+| Vhd -> "vhd"
+| Aio -> "aio"
+
+let invoke_tap_ctl ctx cmd args =
+ if ctx.dummy then
+ match cmd with
+ | "allocate" ->
+ let path = Printf.sprintf "%s%d"
(get_blktapstem ctx) (Random.int max_int) in
+ Unixext.mkdir_rec (Filename.dirname path) 0o700;
+ Unix.close (Unix.openfile path [Unix.O_RDWR;
Unix.O_CREAT; Unix.O_EXCL] 0o700);
+ path
+ | _ -> ""
+ else
+ let stdout, stderr = execute_command_get_output ~env:[|"PATH="
^ (Sys.getenv "PATH") |] "/usr/sbin/tap-ctl" (cmd::args) in
+ stdout
+
+let allocate ctx =
+ let result = invoke_tap_ctl ctx "allocate" [] in
+ let stem = get_tapdevstem ctx in
+ let stemlen = String.length stem in
+ assert(String.startswith stem result);
+ let minor_str = (String.sub result stemlen (String.length result -
stemlen)) in
+ let minor = Scanf.sscanf minor_str "%d" (fun d -> d) in
+ minor
+
+let devnode ctx minor =
+ Printf.sprintf "%s%d" (get_tapdevstem ctx) minor
+
+let spawn ctx =
+ let result = invoke_tap_ctl ctx "spawn" [] in
+ let pid = Scanf.sscanf result "%d" (fun d -> d) in
+ pid
+
+let attach ctx pid minor =
+ let _ = invoke_tap_ctl ctx "attach" ["-p"; string_of_int pid; "-m";
string_of_int minor] in
+ {minor=minor; tapdisk_pid=pid}
+
+let args tapdev =
+ ["-p"; string_of_int tapdev.tapdisk_pid; "-m"; string_of_int
tapdev.minor]
+
+let _open ctx t leaf_path driver =
+ ignore(invoke_tap_ctl ctx "open" (args t @ ["-a"; Printf.sprintf
"%s:%s" (string_of_driver driver) leaf_path]))
+
+let close ctx t =
+ ignore(invoke_tap_ctl ctx "close" (args t))
+
+let pause ctx t =
+ ignore(invoke_tap_ctl ctx "pause" (args t))
+
+let unpause ctx t leaf_path driver =
+ ignore(invoke_tap_ctl ctx "unpause" (args t @ [ "-a"; Printf.sprintf
"%s:%s" (string_of_driver driver) leaf_path ]))
+
+let detach ctx t =
+ ignore(invoke_tap_ctl ctx "detach" (args t))
+
+let free ctx minor =
+ ignore(invoke_tap_ctl ctx "free" ["-m"; string_of_int minor])
+
+let list ?t ctx =
+ let args = match t with
+ | Some tapdev -> args tapdev
+ | None -> []
+ in
+ let result = invoke_tap_ctl ctx "list" args in
+ let lines = String.split '\n' result in
+ List.filter_map (fun line ->
+ try
+ let fields = String.split_f String.isspace line in
+ let assoc = List.filter_map (fun field ->
+ match String.split '=' field with
+ | x::ys ->
+ Some (x,String.concat "=" ys)
+ | _ ->
+ None) fields
+ in
+ let args =
+ match String.split ':' (List.assoc "args"
assoc) with
+ | ty::arguments ->
+ Some (ty,String.concat ":"
arguments)
+ | _ -> None
+ in
+ Some ({tapdisk_pid=int_of_string (List.assoc "pid"
assoc); minor=int_of_string (List.assoc "minor" assoc)},(List.assoc "state"
assoc),args)
+ with _ -> None) lines
+
+let is_paused ctx t =
+ let result = list ~t ctx in
+ match result with
+ | [(tapdev,state,args)] -> state="0x2a"
+ | _ -> failwith "Unknown device"
+
+let is_active ctx t =
+ let result = list ~t ctx in
+ match result with
+ | [(tapdev,state,Some _ )] -> true
+ | _ -> false
+
+let of_device ctx path =
+ let minor = (Unix.stat path).Unix.st_rdev mod 256 in
+ match List.filter (fun (tapdev, _, _) -> tapdev.minor = minor) (list
ctx) with
+ | [ t ] -> t
+ | _ -> raise Not_found
diff -r 5f9ab87260fc -r 815d0a9b3661 tapctl/tapctl.mli
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tapctl/tapctl.mli Fri Jul 23 17:46:18 2010 +0100
@@ -0,0 +1,30 @@
+(** Represents an active tapdisk instance *)
+type tapdev
+val tapdev_of_rpc : Rpc.t -> tapdev
+val rpc_of_tapdev : tapdev -> Rpc.t
+
+type t = tapdev * string * (string * string) option
+
+type context
+val create : unit -> context
+
+type driver = Vhd | Aio
+val string_of_driver : driver -> string
+
+val allocate : context -> int
+val devnode : context -> int -> string
+val spawn : context -> int
+val attach : context -> int -> int -> tapdev
+val args : tapdev -> string list
+val _open : context -> tapdev -> string -> driver -> unit
+val close : context -> tapdev -> unit
+val pause : context -> tapdev -> unit
+val unpause : context -> tapdev -> string -> driver -> unit
+val detach : context -> tapdev -> unit
+val free : context -> int -> unit
+val list : ?t:tapdev -> context -> t list
+val is_paused : context -> tapdev -> bool
+val is_active : context -> tapdev -> bool
+
+(** Given a path to a device, return the corresponding tap information *)
+val of_device : context -> string -> t
diff -r 5f9ab87260fc -r 815d0a9b3661 xapi-libs.spec
--- a/xapi-libs.spec Thu Jul 22 15:37:45 2010 +0100
+++ b/xapi-libs.spec Fri Jul 23 17:46:18 2010 +0100
@@ -292,6 +292,12 @@
/usr/lib/ocaml/cpuid/cpuid.cmxa
/usr/lib/ocaml/cpuid/dllcpuid_stubs.so
/usr/lib/ocaml/cpuid/libcpuid_stubs.a
+ /usr/lib/ocaml/tapctl/META
+ /usr/lib/ocaml/tapctl/tapctl.a
+ /usr/lib/ocaml/tapctl/tapctl.cma
+ /usr/lib/ocaml/tapctl/tapctl.cmi
+ /usr/lib/ocaml/tapctl/tapctl.cmx
+ /usr/lib/ocaml/tapctl/tapctl.cmxa
/usr/lib/ocaml/netdev/*
/usr/lib/ocaml/eventchn/META
/usr/lib/ocaml/eventchn/dlleventchn_stubs.so
Makefile.in | 5 ++
tapctl/META.in | 5 ++
tapctl/Makefile | 68 ++++++++++++++++++++++++++++
tapctl/tapctl.ml | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
tapctl/tapctl.mli | 30 ++++++++++++
xapi-libs.spec | 6 ++
6 files changed, 244 insertions(+), 0 deletions(-)
xen-api-libs.hg.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home