mirrors/libguestfs
1
0
Fork 0
mirror of https://github.com/libguestfs/libguestfs.git synced 2026-03-22 07:03:38 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
stable-1.58
libguestfs/generator/csharp.ml
Richard W.M. Jones 02b64d5cec generator: Use quoted string literals in many places 
This change was done almost entirely automatically using the script
below.  This uses the OCaml lexer to read the source files and extract
the strings and locations.  Strings which are "candidates" (in this
case, longer than 3 lines) are replaced in the output with quoted
string literals.

Since the OCaml lexer is used, it already substitutes all escape
sequences correctly.  I diffed the output of the generator and it is
identical after this change, except for UUIDs, which change because of
how Utils.stable_uuid is implemented.

Thanks: Nicolas Ojeda Bar

$ ocamlfind opt -package unix,compiler-libs.common find_strings.ml \
                -o find_strings.opt -linkpkg
$ for f in $( git ls-files -- \*.ml ) ; do ./find_strings.opt $f ; done

open Printf

let read_whole_file path =
  let buf = Buffer.create 16384 in
  let chan = open_in path in
  let maxlen = 16384 in
  let b = Bytes.create maxlen in
  let rec loop () =
    let r = input chan b 0 maxlen in
    if r > 0 then (
      Buffer.add_substring buf (Bytes.to_string b) 0 r;
      loop ()
    )
  in
  loop ();
  close_in chan;
  Buffer.contents buf

let count_chars c str =
  let count = ref 0 in
  for i = 0 to String.length str - 1 do
    if c = String.unsafe_get str i then incr count
  done;
  !count

let subs = ref []

let consider_string str loc =
  let nr_lines = count_chars '\n' str in
  if nr_lines > 3 then
    subs := (str, loc) :: !subs

let () =
  Lexer.init ();
  let filename = Sys.argv.(1) in
  let content = read_whole_file filename in
  let lexbuf = Lexing.from_string content in
  let rec loop () =
    let token = Lexer.token lexbuf in
    (match token with
     | Parser.EOF -> ();
     | STRING (s, loc, sopt) ->
        consider_string s loc; (* sopt? *)
        loop ();
     | token ->
        loop ();
    )
  in
  loop ();

  (* The list of subs is already reversed, which is convenient
   * because we must the file substitutions in reverse order.
   *)
  let subs = !subs in
  let new_content = ref content in
  List.iter (
    fun (str, loc) ->
      let { Location.loc_start = { pos_cnum = p1 };
            loc_end = { pos_cnum = p2 } } = loc in
      let len = String.length !new_content in
      let before = String.sub !new_content 0 (p1-1) in
      let after = String.sub !new_content (p2+1) (len - p2 - 1) in
      new_content := before ^ "{|" ^ str ^ "|}" ^ after
  ) subs;

  let new_content = !new_content in

  if content <> new_content then (
    (* Update the file in place. *)
    let new_filename = filename ^ ".new"
    and backup_filename = filename ^ ".bak" in
    let chan = open_out new_filename in
    fprintf chan "%s" new_content;
    close_out chan;
    Unix.rename filename backup_filename;
    Unix.rename new_filename filename
  )
2025-09-01 17:08:52 +01:00

290 lines
8.5 KiB
OCaml
Raw Permalink Blame History

(* libguestfs
* Copyright (C) 2009-2025 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*)
(* Please read generator/README first. *)
open Printf
open Std_utils
open Types
open Utils
open Pr
open Docstrings
open Optgroups
open Actions
open Structs
let generate_header = generate_header ~inputs:["generator/csharp.ml"]
let rec generate_csharp () =
generate_header CPlusPlusStyle LGPLv2plus;
(* XXX Make this configurable by the C# assembly users. *)
let library = "libguestfs.so.0" in
pr {|// These C# bindings are highly experimental at present.
//
// Firstly they only work on Linux (ie. Mono). In order to get them
// to work on Windows (ie. .Net) you would need to port the library
// itself to Windows first.
//
// The second issue is that some calls are known to be incorrect and
// can cause Mono to segfault. Particularly: calls which pass or
// return string[], or return any structure value. This is because
// we haven't worked out the correct way to do this from C#. Also
// we don't handle functions that take optional arguments at all.
//
// The third issue is that when compiling you get a lot of warnings.
// We are not sure whether the warnings are important or not.
//
// Fourthly we do not routinely build or test these bindings as part
// of the make && make check cycle, which means that regressions might
// go unnoticed.
//
// Suggestions and patches are welcome.
// To compile:
//
// gmcs Libguestfs.cs
// mono Libguestfs.exe
//
// (You'll probably want to add a Test class / static main function
// otherwise this won't do anything useful).
using System;
using System.IO;
using System.Runtime.InteropServices;
using System.Runtime.Serialization;
using System.Collections;
namespace Guestfs
{
class Error : System.ApplicationException
{
public Error (string message) : base (message) {}
protected Error (SerializationInfo info, StreamingContext context) {}
}
class Guestfs
{
IntPtr _handle;
[DllImport ("%s")]
static extern IntPtr guestfs_create ();
public Guestfs ()
{
_handle = guestfs_create ();
if (_handle == IntPtr.Zero)
throw new Error ("could not create guestfs handle");
}
[DllImport ("%s")]
static extern void guestfs_close (IntPtr h);
~Guestfs ()
{
guestfs_close (_handle);
}
[DllImport ("%s")]
static extern string guestfs_last_error (IntPtr h);
|} library library library;
(* Generate C# structure bindings. We prefix struct names with
* underscore because C# cannot have conflicting struct names and
* method names (eg. "class stat" and "stat").
*)
List.iter (
fun { s_name = typ; s_cols = cols } ->
pr " [StructLayout (LayoutKind.Sequential)]\n";
pr " public class _%s {\n" typ;
List.iter (
function
| name, FChar -> pr " char %s;\n" name
| name, (FString | FDevice) -> pr " string %s;\n" name
| name, FBuffer ->
pr " uint %s_len;\n" name;
pr " string %s;\n" name
| name, FUUID ->
pr " [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
pr " string %s;\n" name
| name, FUInt32 -> pr " uint %s;\n" name
| name, FInt32 -> pr " int %s;\n" name
| name, (FUInt64|FBytes) -> pr " ulong %s;\n" name
| name, FInt64 -> pr " long %s;\n" name
| name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
) cols;
pr " }\n";
pr "\n"
) external_structs;
(* Generate C# function bindings. *)
List.iter (
fun { name; style = ret, args, optargs; c_function;
shortdesc; non_c_aliases } ->
let rec csharp_return_type () =
match ret with
| RErr -> "void"
| RBool n -> "bool"
| RInt n -> "int"
| RInt64 n -> "long"
| RConstString n
| RConstOptString n
| RString (_, n)
| RBufferOut n -> "string"
| RStruct (_,n) -> "_" ^ n
| RHashtable _ -> "Hashtable"
| RStringList _ -> "string[]"
| RStructList (_,n) -> sprintf "_%s[]" n
and c_return_type () =
match ret with
| RErr
| RBool _
| RInt _ -> "int"
| RInt64 _ -> "long"
| RConstString _
| RConstOptString _
| RString _
| RBufferOut _ -> "string"
| RStruct (_,n) -> "_" ^ n
| RHashtable _
| RStringList _ -> "string[]"
| RStructList (_,n) -> sprintf "_%s[]" n
and c_error_comparison () =
match ret with
| RErr
| RBool _
| RInt _
| RInt64 _ -> "== -1"
| RConstString _
| RConstOptString _
| RString _
| RBufferOut _
| RStruct (_,_)
| RHashtable _
| RStringList _
| RStructList (_,_) -> "== null"
and generate_extern_prototype () =
pr " static extern %s %s (IntPtr h"
(c_return_type ()) c_function;
List.iter (
function
| String (_, n)
| OptString n
| BufferIn n ->
pr ", [In] string %s" n
| StringList (_, n) ->
pr ", [In] string[] %s" n
| Bool n ->
pr ", bool %s" n
| Int n ->
pr ", int %s" n
| Int64 n | Pointer (_, n) ->
pr ", long %s" n
) args;
if optargs <> [] then pr ", void *";
pr ");\n"
and generate_public_prototype name =
pr " public %s %s (" (csharp_return_type ()) name;
let comma = ref false in
let next () =
if !comma then pr ", ";
comma := true
in
List.iter (
function
| String (_, n)
| OptString n
| BufferIn n ->
next (); pr "string %s" n
| StringList (_, n) ->
next (); pr "string[] %s" n
| Bool n ->
next (); pr "bool %s" n
| Int n ->
next (); pr "int %s" n
| Int64 n | Pointer (_, n) ->
next (); pr "long %s" n
) args;
pr ")\n"
and generate_call () =
pr "%s (_handle" c_function;
List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
(* C# bindings don't deal with optargs at all, so just pass
* NULL for the structure here.
*)
if optargs <> [] then pr ", NULL";
pr ");\n";
and generate_alias alias =
generate_public_prototype alias;
pr " {\n";
(match ret with
| RErr -> pr " ";
| _ -> pr " return "
);
pr "%s (%s);\n" name (String.concat ", " (List.map name_of_argt args));
pr " }\n";
pr "\n";
in
pr " [DllImport (\"%s\")]\n" library;
generate_extern_prototype ();
pr "\n";
pr " /// <summary>\n";
pr " /// %s\n" shortdesc;
pr " /// </summary>\n";
generate_public_prototype name;
pr " {\n";
pr " %s r;\n" (c_return_type ());
pr " r = ";
generate_call ();
pr " if (r %s)\n" (c_error_comparison ());
pr " throw new Error (guestfs_last_error (_handle));\n";
(match ret with
| RErr -> ()
| RBool _ ->
pr " return r != 0 ? true : false;\n"
| RHashtable _ ->
pr " Hashtable rr = new Hashtable ();\n";
pr " for (size_t i = 0; i < r.Length; i += 2)\n";
pr " rr.Add (r[i], r[i+1]);\n";
pr " return rr;\n"
| RInt _ | RInt64 _ | RConstString _ | RConstOptString _
| RString _ | RBufferOut _ | RStruct _ | RStringList _
| RStructList _ ->
pr " return r;\n"
);
pr " }\n";
pr "\n";
List.iter generate_alias non_c_aliases
) (actions |> external_functions |> sort);
pr " }
}
"
Reference in New Issue View Git Blame Copy Permalink