From: Richard Jones Date: Tue, 6 Oct 2009 14:50:07 +0000 (+0100) Subject: Safer curses functions. X-Git-Tag: 1.0.5~33 X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=commitdiff_plain;h=60e00810a3a81df5186ffc3cec2e2c975e2722fb Safer curses functions. Add safer curses functions which don't require use of dangerous ignore() function. --- diff --git a/virt-top/virt_top.ml b/virt-top/virt_top.ml index 1a39e06..d0b563a 100644 --- a/virt-top/virt_top.ml +++ b/virt-top/virt_top.ml @@ -363,9 +363,16 @@ let message_lineno = 3 let header_lineno = 4 let domains_lineno = 5 +(* Easier to use versions of curses functions addstr, mvaddstr, etc. *) +let move y x = ignore (move y x) +let refresh () = ignore (refresh ()) +let addch c = ignore (addch (int_of_char c)) +let addstr s = ignore (addstr s) +let mvaddstr y x s = ignore (mvaddstr y x s) + (* Print in the "message area". *) -let clear_msg () = ignore (move message_lineno 0); clrtoeol () -let print_msg str = clear_msg (); ignore (mvaddstr message_lineno 0 str) +let clear_msg () = move message_lineno 0; clrtoeol () +let print_msg str = clear_msg (); mvaddstr message_lineno 0 str (* Intermediate "domain + stats" structure that we use to collect * everything we know about a domain within the collect function. @@ -751,13 +758,13 @@ let redraw = let lines, cols = get_size () in (* Time. *) - ignore (mvaddstr top_lineno 0 ("virt-top " ^ printable_time ^ " - ")); + mvaddstr top_lineno 0 (sprintf "virt-top %s - " printable_time); (* Basic node_info. *) - ignore (addstr - (sprintf "%s %d/%dCPU %dMHz %LdMB " - node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz - (node_info.C.memory /^ 1024L))); + addstr + (sprintf "%s %d/%dCPU %dMHz %LdMB " + node_info.C.model node_info.C.cpus nr_pcpus node_info.C.mhz + (node_info.C.memory /^ 1024L)); (* Save the cursor position for when we come to draw the * historical CPU times (down in this function). *) @@ -838,9 +845,8 @@ let redraw = (* Print domains. *) attron A.reverse; - ignore ( - mvaddstr header_lineno 0 - (pad cols " ID S RDRQ WRRQ RXBY TXBY %CPU %MEM TIME NAME")); + mvaddstr header_lineno 0 + (pad cols " ID S RDRQ WRRQ RXBY TXBY %CPU %MEM TIME NAME"); attroff A.reverse; let rec loop lineno = function @@ -863,7 +869,7 @@ let redraw = rd.rd_domid state rd_req wr_req rx_bytes tx_bytes percent_cpu percent_mem time name in let line = pad cols line in - ignore (mvaddstr lineno 0 line); + mvaddstr lineno 0 line; loop (lineno+1) doms ) | (name, Inactive) :: doms -> (* inactive domain *) @@ -873,7 +879,7 @@ let redraw = " - (%s)" name in let line = pad cols line in - ignore (mvaddstr lineno 0 line); + mvaddstr lineno 0 line; loop (lineno+1) doms ) in @@ -896,17 +902,16 @@ let redraw = ) doms ) in attron A.reverse; - ignore ( - mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names))); + mvaddstr header_lineno 0 (pad cols ("PHYCPU %CPU " ^ dom_names)); attroff A.reverse; Array.iteri ( fun p row -> - ignore (mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p)); + mvaddstr (p+domains_lineno) 0 (sprintf "%4d " p); let cpu_time = pcpus_cpu_time.(p) in (* ns used on this CPU *) let percent_cpu = 100. *. cpu_time /. total_cpu_per_pcpu in - ignore (addstr (Show.percent percent_cpu)); - ignore (addch 32); + addstr (Show.percent percent_cpu); + addch ' '; List.iteri ( fun di (domid, name, _, _, _, _, _) -> @@ -922,7 +927,7 @@ let redraw = (if is_average then '=' else ' ') (if is_running then '#' else ' ') ) in - ignore (addstr (pad width str)); + addstr (pad width str); () ) doms ) pcpus; @@ -996,9 +1001,8 @@ let redraw = (* Print the header for network devices. *) attron A.reverse; - ignore ( - mvaddstr header_lineno 0 - (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE")); + mvaddstr header_lineno 0 + (pad cols " ID S RXBY TXBY RXPK TXPK DOMAIN INTERFACE"); attroff A.reverse; (* Print domains and devices. *) @@ -1030,7 +1034,7 @@ let redraw = rx_packets tx_packets (pad 12 name) dev in let line = pad cols line in - ignore (mvaddstr lineno 0 line); + mvaddstr lineno 0 line; loop (lineno+1) devs ) in @@ -1105,9 +1109,8 @@ let redraw = (* Print the header for block devices. *) attron A.reverse; - ignore ( - mvaddstr header_lineno 0 - (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE")); + mvaddstr header_lineno 0 + (pad cols " ID S RDBY WRBY RDRQ WRRQ DOMAIN DEVICE"); attroff A.reverse; (* Print domains and devices. *) @@ -1139,7 +1142,7 @@ let redraw = rd_req wr_req (pad 12 name) dev in let line = pad cols line in - ignore (mvaddstr lineno 0 line); + mvaddstr lineno 0 line; loop (lineno+1) devs ) in @@ -1150,18 +1153,17 @@ let redraw = crashed, active, inactive, total_cpu_time, total_memory, total_domU_memory) = totals in - ignore ( - mvaddstr summary_lineno 0 - (sprintf (f_ "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d") - count active running blocked paused inactive shutdown shutoff - crashed)); + mvaddstr summary_lineno 0 + (sprintf + (f_ "%d domains, %d active, %d running, %d sleeping, %d paused, %d inactive D:%d O:%d X:%d") + count active running blocked paused inactive shutdown shutoff crashed); (* Total %CPU used, and memory summary. *) let percent_cpu = 100. *. total_cpu_time /. total_cpu in - ignore ( - mvaddstr (summary_lineno+1) 0 - (sprintf (f_ "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)") - percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L))); + mvaddstr (summary_lineno+1) 0 + (sprintf + (f_ "CPU: %2.1f%% Mem: %Ld MB (%Ld MB by guests)") + percent_cpu (total_memory /^ 1024L) (total_domU_memory /^ 1024L)); (* Time to grab another historical %CPU for the list? *) if time >= !historical_cpu_last_time +. float !historical_cpu_delay @@ -1178,13 +1180,11 @@ let redraw = String.concat " " (List.map (sprintf "%2.1f%%") !historical_cpu) in let line = pad maxwidth line in - ignore (mvaddstr y x line); + mvaddstr y x line; () in - (* Park cursor in message area, as with top. *) - ignore (move message_lineno 0); - ignore (refresh ()); (* Refresh the display. *) - () + move message_lineno 0; (* Park cursor in message area, as with top. *) + refresh () (* Refresh the display. *) (* Write CSV header row. *) let write_csv_header () = @@ -1346,18 +1346,18 @@ and change_delay () = with Failure "float_of_string" -> print_msg (s_ "Not a valid number"); true in - ignore (refresh ()); + refresh (); sleep (if error then 2 else 1) and change_sort_order () = clear (); let lines, cols = get_size () in - ignore (mvaddstr top_lineno 0 (s_ "Set sort order for main display")); - ignore (mvaddstr summary_lineno 0 (s_ "Type key or use up and down cursor keys.")); + mvaddstr top_lineno 0 (s_ "Set sort order for main display"); + mvaddstr summary_lineno 0 (s_ "Type key or use up and down cursor keys."); attron A.reverse; - ignore (mvaddstr header_lineno 0 (pad cols "KEY Sort field")); + mvaddstr header_lineno 0 (pad cols "KEY Sort field"); attroff A.reverse; let accelerator_key = function @@ -1385,15 +1385,15 @@ and change_sort_order () = fun i ord -> let selected = !sort_order = ord in if selected then selected_index := i; - ignore (mvaddstr (domains_lineno+i) 0 - (sprintf " %c %s %s %s" - (key_of_int i) (if selected then "*" else " ") - (printable_sort_order ord) - (accelerator_key ord))) + mvaddstr (domains_lineno+i) 0 + (sprintf " %c %s %s %s" + (key_of_int i) (if selected then "*" else " ") + (printable_sort_order ord) + (accelerator_key ord)) ) all_sort_fields; - ignore (move message_lineno 0); - ignore (refresh ()); + move message_lineno 0; + refresh (); let k = getch () in if k >= 0 && k <> 32 && k <> Char.code 'q' && k <> 13 then ( let new_order, loop = @@ -1437,7 +1437,7 @@ and change_sort_order () = print_msg (sprintf "Sort order changed to: %s" (printable_sort_order new_order)); if not loop then ( - ignore (refresh ()); + refresh (); sleep 1 ) ); @@ -1537,15 +1537,15 @@ and _write_init_file filename = Unix.rename (filename ^ ".new") filename; print_msg (sprintf (f_ "Wrote settings to %s") filename); - ignore (refresh ()); + refresh (); sleep 2 with | Sys_error err -> - ignore (print_msg (s_ "Error" ^ ": " ^ err)); - ignore (refresh ()); sleep 2 + print_msg (s_ "Error" ^ ": " ^ err); + refresh (); sleep 2 | Unix.Unix_error (err, fn, str) -> - ignore (print_msg (s_ ("Error" ^ ": " ^ Unix.error_message err ^ fn ^ str))); - ignore (refresh ()); + print_msg (s_ ("Error" ^ ": " ^ Unix.error_message err ^ fn ^ str)); + refresh (); sleep 2 and show_help (_, _, _, _, _, hostname, @@ -1557,31 +1557,33 @@ and show_help (_, _, _, _, _, hostname, (* Banner at the top of the screen. *) let banner = - sprintf (f_ "virt-top %s ocaml-libvirt %s libvirt %d.%d.%d by Red Hat") + sprintf (f_"virt-top %s ocaml-libvirt %s libvirt %d.%d.%d by Red Hat") Virt_top_version.version Libvirt_version.version libvirt_major libvirt_minor libvirt_release in let banner = pad cols banner in attron A.reverse; - ignore (mvaddstr 0 0 banner); + mvaddstr 0 0 banner; attroff A.reverse; (* Status. *) - ignore (mvaddstr 1 0 - (sprintf (f_ "Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s") - (float !delay /. 1000.) - (if !batch_mode then "On" else "Off") - (if !secure_mode then "On" else "Off") - (printable_sort_order !sort_order))); - ignore (mvaddstr 2 0 - (sprintf (f_ "Connect: %s; Hostname: %s") - (match !uri with None -> "default" | Some s -> s) - hostname)); + mvaddstr 1 0 + (sprintf + (f_"Delay: %.1f secs; Batch: %s; Secure: %s; Sort: %s") + (float !delay /. 1000.) + (if !batch_mode then s_"On" else s_"Off") + (if !secure_mode then s_"On" else s_"Off") + (printable_sort_order !sort_order)); + mvaddstr 2 0 + (sprintf + (f_"Connect: %s; Hostname: %s") + (match !uri with None -> s_"default" | Some s -> s) + hostname); (* Misc keys on left. *) - let banner = pad 38 (s_ "MAIN KEYS") in + let banner = pad 38 (s_"MAIN KEYS") in attron A.reverse; - ignore (mvaddstr header_lineno 1 banner); + mvaddstr header_lineno 1 banner; attroff A.reverse; let get_lineno = @@ -1590,8 +1592,8 @@ and show_help (_, _, _, _, _, hostname, in let key keys description = let lineno = get_lineno () in - ignore (move lineno 1); attron A.bold; ignore (addstr keys); attroff A.bold; - ignore (move lineno 10); ignore (addstr description) + move lineno 1; attron A.bold; addstr keys; attroff A.bold; + move lineno 10; addstr description in key "space ^L" (s_ "Update display"); key "q" (s_ "Quit"); @@ -1602,7 +1604,7 @@ and show_help (_, _, _, _, _, hostname, ignore (get_lineno ()); let banner = pad 38 (s_ "SORTING") in attron A.reverse; - ignore (mvaddstr (get_lineno ()) 1 banner); + mvaddstr (get_lineno ()) 1 banner; attroff A.reverse; key "P" (s_ "Sort by %CPU"); @@ -1614,7 +1616,7 @@ and show_help (_, _, _, _, _, hostname, (* Display modes on right. *) let banner = pad 39 (s_ "DISPLAY MODES") in attron A.reverse; - ignore (mvaddstr header_lineno 40 banner); + mvaddstr header_lineno 40 banner; attroff A.reverse; let get_lineno = @@ -1623,8 +1625,8 @@ and show_help (_, _, _, _, _, hostname, in let key keys description = let lineno = get_lineno () in - ignore (move lineno 40); attron A.bold; ignore (addstr keys); attroff A.bold; - ignore (move lineno 49); ignore (addstr description) + move lineno 40; attron A.bold; addstr keys; attroff A.bold; + move lineno 49; addstr description in key "0" (s_ "Domains display"); key "1" (s_ "Toggle physical CPUs"); @@ -1632,12 +1634,12 @@ and show_help (_, _, _, _, _, hostname, key "3" (s_ "Toggle block devices"); (* Update screen and wait for key press. *) - ignore (mvaddstr (lines-1) 0 - (s_ "More help in virt-top(1) man page. Press any key to return.")); - ignore (refresh ()); + mvaddstr (lines-1) 0 + (s_ "More help in virt-top(1) man page. Press any key to return."); + refresh (); ignore (getch ()) and unknown_command k = print_msg (s_ "Unknown command - try 'h' for help"); - ignore (refresh ()); + refresh (); sleep 1