Browse Source
Implemented at the moment: - complete Perl 5 XS binding library wrapping core standalone structures; - automated ppport.h generation and ExtUtils::MakeMaker compilation path; - native system tree mapping example utilizing BSD::Sysctl and strict UTF-8 streams.master
6 changed files with 412 additions and 0 deletions
@ -0,0 +1,111 @@ |
|||
#!/usr/bin/env perl |
|||
|
|||
use strict; |
|||
use warnings; |
|||
use utf8; |
|||
use open qw/:std :encoding(utf8)/; |
|||
|
|||
# Automatically inject local compilation paths for out-of-tree testing execution |
|||
use blib '../modules/perl'; |
|||
use bsdiskinfo; |
|||
|
|||
# Attempt to load standard FreeBSD sysctl bindings to read disks mapping arrays |
|||
my $disks_str = ""; |
|||
if (eval { require BSD::Sysctl; 1 }) { |
|||
$disks_str = BSD::Sysctl::sysctl("kern.disks") // ""; |
|||
} else { |
|||
# Fallback to pure shell execution path if Sys::Sysctl module is missing |
|||
$disks_str = `sysctl -n kern.disks`; |
|||
chomp($disks_str); |
|||
} |
|||
|
|||
if (!$disks_str) { |
|||
die "Error: Failed to query kern.disks operational tree components.\n"; |
|||
} |
|||
|
|||
# Parse disk names into a sorted sequential array structure |
|||
my @disks = sort (split /\s+/, $disks_str); |
|||
|
|||
# In-memory dictionary map expanding basic S.M.A.R.T attribute metrics names |
|||
my %smart_names = ( |
|||
1 => "Raw_Read_Error_Rate", |
|||
3 => "Spin_Up_Time", |
|||
4 => "Start_Stop_Count", |
|||
5 => "Reallocated_Sector_Ct", |
|||
7 => "Seek_Error_Rate", |
|||
9 => "Power_On_Hours", |
|||
10 => "Spin_Retry_Count", |
|||
12 => "Power_Cycle_Count", |
|||
184 => "End-to-End_Error", |
|||
187 => "Reported_Uncorrect", |
|||
188 => "Command_Timeout", |
|||
189 => "High_Fly_Writes", |
|||
190 => "Airflow_Temperature_Cel", |
|||
193 => "Load_Cycle_Count", |
|||
194 => "Temperature_Celsius", |
|||
195 => "Hardware_ECC_Recovered", |
|||
197 => "Current_Pending_Sector", |
|||
198 => "Offline_Uncorrectable", |
|||
199 => "UDMA_CRC_Error_Count", |
|||
240 => "Head_Flying_Hours", |
|||
241 => "Total_LBAs_Written", |
|||
242 => "Total_LBAs_Read" |
|||
); |
|||
|
|||
print "=========================================================================\n"; |
|||
print " bsdiskinfo Nested Architecture Tree Map View Emulator (Perl 5 XS)\n"; |
|||
print "=========================================================================\n\n"; |
|||
|
|||
# Traverse detected hardware storage entries loops |
|||
for my $disk (@disks) { |
|||
next unless bsdiskinfo::exists($disk); |
|||
|
|||
my $props = get_properties($disk); |
|||
next unless $props; |
|||
|
|||
# Format human readable capacities representation bounds |
|||
my $size_str = "N/A"; |
|||
if ($props->{mediasize}) { |
|||
my $gib = $props->{mediasize} / (1024 * 1024 * 1024); |
|||
$size_str = $gib >= 1024 ? sprintf("%.1f TiB", $gib / 1024) : sprintf("%.1f GiB", $gib); |
|||
} |
|||
|
|||
print "Drive node: /dev/$disk [$props->{type}, $size_str]\n"; |
|||
print " ├─ Model : $props->{model}\n"; |
|||
print " ├─ Serial : $props->{serial}\n"; |
|||
print " ├─ Firmware : $props->{fw_version}\n"; |
|||
print " └─ WWN : $props->{wwn}\n"; |
|||
|
|||
# Intercept and process partition mount hashes |
|||
my $mounts = get_mounts($disk); |
|||
if ($mounts && @$mounts) { |
|||
print " ├── Active Mounted Volumes:\n"; |
|||
for my $mnt (@$mounts) { |
|||
print sprintf(" │ └─ /dev/%-7s -> %-20s (%s)\n", $mnt->{device}, $mnt->{path}, $mnt->{fstype}); |
|||
} |
|||
} else { |
|||
print " ├── Active Mounted Volumes: None detected\n"; |
|||
} |
|||
|
|||
# Evaluate S.M.A.R.T diagnostic matrices data fields |
|||
if ($props->{smart_supported}) { |
|||
my $smart = get_smart_counters($disk); |
|||
if ($smart && @$smart) { |
|||
my $temp = "N/A"; |
|||
# Unpack temperature telemetry using low-byte bitmasking rules |
|||
for my $attr (@$smart) { |
|||
if ($attr->{id} == 194 || $attr->{id} == 190) { |
|||
$temp = sprintf("%d°C", $attr->{raw_val} & 0xFF); |
|||
last; |
|||
} |
|||
} |
|||
print " └── S.M.A.R.T. Operational Status: Enabled [Temp: $temp, Metrics: " . scalar(@$smart) . "]\n"; |
|||
} else { |
|||
print " └── S.M.A.R.T. Operational Status: Read Failed\n"; |
|||
} |
|||
} else { |
|||
print " └── S.M.A.R.T. Operational Status: Not Supported\n"; |
|||
} |
|||
print "-------------------------------------------------------------------------\n"; |
|||
} |
|||
|
|||
@ -0,0 +1,24 @@ |
|||
use 5.006; |
|||
use ExtUtils::MakeMaker; |
|||
|
|||
if (eval { require Devel::PPPort; 1 }) { |
|||
Devel::PPPort::WriteFile(); |
|||
} else { |
|||
warn "Warning: Devel::PPPort is not installed, compilation might fail if ppport.h is missing.\n"; |
|||
} |
|||
|
|||
WriteMakefile( |
|||
NAME => 'bsdiskinfo', |
|||
VERSION_FROM => 'lib/bsdiskinfo.pm', # finds $VERSION |
|||
PREREQ_PM => {}, # e.g., Module::Name => 1.1 |
|||
ABSTRACT_FROM => 'lib/bsdiskinfo.pm', # retrieve abstract from module |
|||
AUTHOR => 'Your Name <your.email@domain.com>', |
|||
LICENSE => 'bsd', |
|||
LIBS => ['-L../.. -lbsdiskinfo -lcam'], # Link against our core engine |
|||
DEFINE => '', # e.g., '-DHAVE_SOMETHING' |
|||
INC => '-I. -I../../include', # Find public C headers |
|||
OBJECT => '$(O_FILES)', # link all the C files too |
|||
# Ensure runtime loader (rtld) can find libbsdiskinfo.so during tests |
|||
dynamic_lib => { OTHERLDFLAGS => '-Wl,-rpath,/usr/local/lib:../..' }, |
|||
); |
|||
|
|||
@ -0,0 +1,123 @@ |
|||
#define PERL_NO_GET_CONTEXT |
|||
#include "EXTERN.h" |
|||
#include "perl.h" |
|||
#include "XSUB.h" |
|||
|
|||
#include "ppport.h" |
|||
#include "../../include/bsdiskinfo.h" |
|||
|
|||
MODULE = bsdiskinfo PACKAGE = bsdiskinfo |
|||
|
|||
PROTOTYPES: DISABLE |
|||
|
|||
bool |
|||
exists(base_disk) |
|||
const char * base_disk |
|||
CODE: |
|||
RETVAL = diskinfo_exists(base_disk); |
|||
OUTPUT: |
|||
RETVAL |
|||
|
|||
SV * |
|||
get_properties(base_disk) |
|||
const char * base_disk |
|||
PREINIT: |
|||
struct disk_properties props; |
|||
HV *hv; |
|||
CODE: |
|||
if (diskinfo_get_properties(base_disk, &props) != 0) { |
|||
XSRETURN_UNDEF; |
|||
} |
|||
|
|||
/* Create a new Perl Hash to store properties */ |
|||
hv = newHV(); |
|||
|
|||
/* Populate strings */ |
|||
hv_store(hv, "model", 5, newSVpv(props.model, 0), 0); |
|||
hv_store(hv, "serial", 6, newSVpv(props.serial, 0), 0); |
|||
hv_store(hv, "fw_version", 10, newSVpv(props.fw_version, 0), 0); |
|||
hv_store(hv, "wwn", 3, newSVpv(props.wwn, 0), 0); |
|||
hv_store(hv, "type", 4, newSVpv(props.type_str, 0), 0); |
|||
|
|||
/* Populate numeric capacities as NV (double) for safe 64-bit integer handling in Perl */ |
|||
hv_store(hv, "mediasize", 9, newSVnv((NV)props.mediasize), 0); |
|||
|
|||
/* Populate geometry integers */ |
|||
hv_store(hv, "logical_sector_size", 19, newSViv(props.logical_sector_size), 0); |
|||
hv_store(hv, "physical_sector_size", 20, newSViv(props.physical_sector_size), 0); |
|||
|
|||
if (props.rotation_rate >= 0) { |
|||
hv_store(hv, "rotation_rate", 13, newSViv(props.rotation_rate), 0); |
|||
} |
|||
|
|||
if (props.smart_supported >= 0) { |
|||
hv_store(hv, "smart_supported", 15, newSVbool(props.smart_supported == 1), 0); |
|||
hv_store(hv, "smart_enabled", 13, newSVbool(props.smart_enabled == 1), 0); |
|||
} |
|||
|
|||
/* Return as a reference to the hash */ |
|||
RETVAL = newRV_noinc((SV *)hv); |
|||
OUTPUT: |
|||
RETVAL |
|||
|
|||
SV * |
|||
get_mounts(base_disk) |
|||
const char * base_disk |
|||
PREINIT: |
|||
struct disk_mount mounts[MAX_MOUNTS]; |
|||
AV *av; |
|||
int count, i; |
|||
CODE: |
|||
count = diskinfo_get_mounts(base_disk, mounts, MAX_MOUNTS); |
|||
if (count < 0) { |
|||
XSRETURN_UNDEF; |
|||
} |
|||
|
|||
/* Create a new Perl Array Container */ |
|||
av = newAV(); |
|||
|
|||
for (i = 0; i < count; i++) { |
|||
HV *hv = newHV(); |
|||
hv_store(hv, "device", 6, newSVpv(mounts[i].device, 0), 0); |
|||
hv_store(hv, "path", 4, newSVpv(mounts[i].path, 0), 0); |
|||
hv_store(hv, "fstype", 6, newSVpv(mounts[i].fstype, 0), 0); |
|||
|
|||
/* Push reference into array without incrementing refcount manually */ |
|||
av_push(av, newRV_noinc((SV *)hv)); |
|||
} |
|||
|
|||
RETVAL = newRV_noinc((SV *)av); |
|||
OUTPUT: |
|||
RETVAL |
|||
|
|||
SV * |
|||
get_smart_counters(base_disk) |
|||
const char * base_disk |
|||
PREINIT: |
|||
struct smart_counter counters[30]; |
|||
AV *av; |
|||
int count, i; |
|||
CODE: |
|||
count = diskinfo_get_smart_counters(base_disk, counters, 30); |
|||
if (count < 0) { |
|||
XSRETURN_UNDEF; |
|||
} |
|||
|
|||
av = newAV(); |
|||
|
|||
for (i = 0; i < count; i++) { |
|||
HV *hv = newHV(); |
|||
hv_store(hv, "id", 2, newSViv(counters[i].id), 0); |
|||
hv_store(hv, "value", 5, newSViv(counters[i].value), 0); |
|||
hv_store(hv, "worst", 5, newSViv(counters[i].worst), 0); |
|||
|
|||
/* High capacity vendor attributes pushed as double float */ |
|||
hv_store(hv, "raw_val", 7, newSVnv((NV)counters[i].raw_val), 0); |
|||
|
|||
av_push(av, newRV_noinc((SV *)hv)); |
|||
} |
|||
|
|||
RETVAL = newRV_noinc((SV *)av); |
|||
OUTPUT: |
|||
RETVAL |
|||
|
|||
@ -0,0 +1,84 @@ |
|||
package bsdiskinfo; |
|||
|
|||
use 5.006; |
|||
use strict; |
|||
use warnings; |
|||
|
|||
require Exporter; |
|||
our @ISA = qw(Exporter); |
|||
|
|||
# Export core functions by default to match Lua behavior |
|||
our @EXPORT = qw( |
|||
exists |
|||
get_properties |
|||
get_mounts |
|||
get_smart_counters |
|||
); |
|||
|
|||
our $VERSION = '0.1'; |
|||
|
|||
# Bootstrap and load the compiled C binary via XS interface component |
|||
require XSLoader; |
|||
XSLoader::load('bsdiskinfo', $VERSION); |
|||
|
|||
1; |
|||
__END__ |
|||
|
|||
=head1 NAME |
|||
|
|||
bsdiskinfo - Native Perl 5 XS bindings for FreeBSD bsdiskinfo library |
|||
|
|||
=head1 SYNOPSIS |
|||
|
|||
use bsdiskinfo; |
|||
|
|||
if (exists("ada0")) { |
|||
my $props = get_properties("ada0"); |
|||
print "Model: $props->{model}\n"; |
|||
print "Serial: $props->{serial}\n"; |
|||
|
|||
my $mounts = get_mounts("ada0"); |
|||
for my $mnt (@$mounts) { |
|||
print "Partition $mnt->{device} mounted at $mnt->{path}\n"; |
|||
} |
|||
} |
|||
|
|||
=head1 DESCRIPTION |
|||
|
|||
This module provides high-performance Perl 5 wrappers over the native |
|||
FreeBSD libbsdiskinfo engine. It maps low-level storage architecture C structs |
|||
straight into fast Perl references (hashes and arrays). |
|||
|
|||
=head1 METHODS |
|||
|
|||
=over 4 |
|||
|
|||
=item B<exists($disk_name)> |
|||
|
|||
Returns a boolean indicating if the target character device file node exists |
|||
under /dev/. |
|||
|
|||
=item B<get_properties($disk_name)> |
|||
|
|||
Returns a hash reference populated with device metadata (model, serial, |
|||
capacity, sector geometry) or undef on errors. |
|||
|
|||
=item B<get_mounts($disk_name)> |
|||
|
|||
Returns an array reference containing hash references of active partitions |
|||
mounted across filesystem layers. |
|||
|
|||
=item B<get_smart_counters($disk_name)> |
|||
|
|||
Returns an array reference storing unpacked vendor-specific S.M.A.R.T. memory |
|||
structures. |
|||
|
|||
=back |
|||
|
|||
=head1 LICENSE |
|||
|
|||
This library is free software; you can redistribute it and/or modify |
|||
it under the terms of the BSD 2-Clause Simplified License. |
|||
|
|||
=cut |
|||
|
|||
Loading…
Reference in new issue