diff --git a/.gitignore b/.gitignore index 49844df..52a5879 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ *.o .openhvf/ build/ +local/ # Exploratory testing explore/ diff --git a/lib/FuguLib/Daemon.pm b/lib/FuguLib/Daemon.pm index fa7d44e..9237613 100644 --- a/lib/FuguLib/Daemon.pm +++ b/lib/FuguLib/Daemon.pm @@ -29,7 +29,7 @@ use POSIX qw(setsid); # %args: # logfile => $path # Where to redirect stdout/stderr (default: /dev/null) # on_fork => sub($) # Callback after fork, receives PID in parent -sub daemonize( $class, %args ) +sub daemonize ( $class, %args ) { my $logfile = $args{logfile} // '/dev/null'; my $on_fork = $args{on_fork}; diff --git a/lib/FuguLib/Log.pm b/lib/FuguLib/Log.pm index ff0beee..6a0366b 100644 --- a/lib/FuguLib/Log.pm +++ b/lib/FuguLib/Log.pm @@ -33,7 +33,7 @@ use constant { MODE_QUIET => 'quiet', }; -sub new( $class, %args ) +sub new ( $class, %args ) { my $mode = $args{mode} // MODE_STDERR; my $level = $args{level} // 'info'; @@ -66,7 +66,7 @@ sub new( $class, %args ) return $self; } -sub DESTROY($self) +sub DESTROY ($self) { if ( $self->{opened} && $self->{mode} eq MODE_SYSLOG ) { closelog(); @@ -74,18 +74,18 @@ sub DESTROY($self) } # Logging methods -sub debug( $self, $fmt, @args ) { $self->_log( 'debug', $fmt, @args ); } -sub info( $self, $fmt, @args ) { $self->_log( 'info', $fmt, @args ); } -sub notice( $self, $fmt, @args ) { $self->_log( 'notice', $fmt, @args ); } -sub warning( $self, $fmt, @args ) { $self->_log( 'warning', $fmt, @args ); } -sub warn( $self, $fmt, @args ) { $self->_log( 'warning', $fmt, @args ); } -sub error( $self, $fmt, @args ) { $self->_log( 'error', $fmt, @args ); } -sub err( $self, $fmt, @args ) { $self->_log( 'error', $fmt, @args ); } -sub crit( $self, $fmt, @args ) { $self->_log( 'crit', $fmt, @args ); } +sub debug ( $self, $fmt, @args ) { $self->_log( 'debug', $fmt, @args ); } +sub info ( $self, $fmt, @args ) { $self->_log( 'info', $fmt, @args ); } +sub notice ( $self, $fmt, @args ) { $self->_log( 'notice', $fmt, @args ); } +sub warning ( $self, $fmt, @args ) { $self->_log( 'warning', $fmt, @args ); } +sub warn ( $self, $fmt, @args ) { $self->_log( 'warning', $fmt, @args ); } +sub error ( $self, $fmt, @args ) { $self->_log( 'error', $fmt, @args ); } +sub err ( $self, $fmt, @args ) { $self->_log( 'error', $fmt, @args ); } +sub crit ( $self, $fmt, @args ) { $self->_log( 'crit', $fmt, @args ); } # $self->_log($level, $fmt, @args): # Internal logging method -sub _log( $self, $level, $fmt, @args ) +sub _log ( $self, $level, $fmt, @args ) { return if $self->{mode} eq MODE_QUIET; @@ -107,7 +107,7 @@ sub _log( $self, $level, $fmt, @args ) # $self->set_level($level): # Change minimum log level -sub set_level( $self, $level ) +sub set_level ( $self, $level ) { $self->{level} = _parse_level($level); } @@ -146,19 +146,19 @@ my %facility_map = ( local7 => LOG_LOCAL7, ); -sub _parse_level($level) +sub _parse_level ($level) { $level = lc($level); return $level_map{$level} // 1; # Default to info } -sub _level_to_priority($level) +sub _level_to_priority ($level) { $level = lc($level); return $priority_map{$level} // LOG_INFO; } -sub _parse_facility($facility) +sub _parse_facility ($facility) { $facility = lc($facility); return $facility_map{$facility} // LOG_DAEMON; diff --git a/lib/FuguLib/Privdrop.pm b/lib/FuguLib/Privdrop.pm index 08d77fb..f7ffd9e 100644 --- a/lib/FuguLib/Privdrop.pm +++ b/lib/FuguLib/Privdrop.pm @@ -42,7 +42,7 @@ use POSIX qw(setuid setgid); # # # Now running as _openhap # $server->run(); -sub drop_privileges( $class, %args ) +sub drop_privileges ( $class, %args ) { my $user = $args{user} or die "user parameter required for drop_privileges"; diff --git a/lib/FuguLib/Process.pm b/lib/FuguLib/Process.pm index 6c598e5..6e34463 100644 --- a/lib/FuguLib/Process.pm +++ b/lib/FuguLib/Process.pm @@ -40,7 +40,7 @@ use POSIX qw(setsid WNOHANG); # on_error => sub($err) # Optional: error callback # on_success => sub($pid) # Optional: success callback # check_alive => $seconds # Optional: wait and verify process is alive -sub spawn_command( $class, %args ) +sub spawn_command ( $class, %args ) { my $cmd = $args{cmd} or return { success => 0, error => 'No command specified' }; @@ -141,7 +141,7 @@ sub spawn_command( $class, %args ) # $class->is_alive($pid): # Check if process is alive (not dead, not zombie) # Returns 1 if alive, 0 if dead or doesn't exist or zombie -sub is_alive( $class, $pid ) +sub is_alive ( $class, $pid ) { return 0 unless defined $pid; return 0 unless $pid =~ /^\d+$/; @@ -172,7 +172,7 @@ sub is_alive( $class, $pid ) # %args: # grace_period => $seconds # Time to wait after TERM before KILL (default: 5) # on_kill => sub() # Called after successful kill -sub terminate( $class, $pid, %args ) +sub terminate ( $class, $pid, %args ) { return 1 unless defined $pid; return 1 unless $class->is_alive($pid); @@ -218,7 +218,7 @@ sub terminate( $class, $pid, %args ) # $class->reap($pid): # Attempt to reap a zombie process # Returns 1 if process was reaped or doesn't exist, 0 if still running -sub reap( $class, $pid ) +sub reap ( $class, $pid ) { return 1 unless defined $pid; return 1 unless $pid =~ /^\d+$/; @@ -234,7 +234,7 @@ sub reap( $class, $pid ) # $class->reap_all(): # Reap all zombie children (non-blocking) # Returns count of children reaped -sub reap_all($class) +sub reap_all ($class) { my $count = 0; while ( waitpid( -1, WNOHANG ) > 0 ) { @@ -246,7 +246,7 @@ sub reap_all($class) # $class->wait_exit($pid, $timeout): # Wait for process to exit # Returns 1 if process exited, 0 if timeout -sub wait_exit( $class, $pid, $timeout = 30 ) +sub wait_exit ( $class, $pid, $timeout = 30 ) { my $start = time; while ( time - $start < $timeout ) { @@ -273,7 +273,7 @@ sub wait_exit( $class, $pid, $timeout = 30 ) # args => [$port, $dir], # daemonize => 1, # ); -sub spawn_perl( $class, %args ) +sub spawn_perl ( $class, %args ) { my $code = delete $args{code} or return { success => 0, error => 'No code specified' }; diff --git a/lib/FuguLib/Signal.pm b/lib/FuguLib/Signal.pm index 4f31683..2d543a7 100644 --- a/lib/FuguLib/Signal.pm +++ b/lib/FuguLib/Signal.pm @@ -31,7 +31,7 @@ our $interrupted = 0; # Stack of cleanup handlers my @cleanup_handlers; -sub new($class) +sub new ($class) { bless { handlers => {}, @@ -42,7 +42,7 @@ sub new($class) # $self->setup_graceful_exit(@signals): # Setup handlers for graceful exit on specified signals # Calls all registered cleanup handlers and exits -sub setup_graceful_exit( $self, @signals ) +sub setup_graceful_exit ( $self, @signals ) { for my $sig (@signals) { $self->{original}{$sig} = $SIG{$sig} // 'DEFAULT'; @@ -59,7 +59,7 @@ sub setup_graceful_exit( $self, @signals ) # $self->setup_interrupt_flag(@signals): # Setup handlers that set interrupt flag without exiting # Allows long-running operations to check and exit cleanly -sub setup_interrupt_flag( $self, @signals ) +sub setup_interrupt_flag ( $self, @signals ) { for my $sig (@signals) { $self->{original}{$sig} = $SIG{$sig} // 'DEFAULT'; @@ -72,7 +72,7 @@ sub setup_interrupt_flag( $self, @signals ) # $self->add_cleanup($handler): # Add cleanup handler to be called on signal # Handler receives signal name as argument -sub add_cleanup( $self, $handler ) +sub add_cleanup ( $self, $handler ) { push @cleanup_handlers, $handler; return $self; @@ -80,7 +80,7 @@ sub add_cleanup( $self, $handler ) # $self->restore(): # Restore original signal handlers -sub restore($self) +sub restore ($self) { for my $sig ( keys %{ $self->{handlers} } ) { $SIG{$sig} = $self->{original}{$sig}; @@ -104,7 +104,7 @@ sub reset_interrupted() $interrupted = 0; } -sub _run_cleanup_handlers( $self, $signal ) +sub _run_cleanup_handlers ( $self, $signal ) { for my $handler (@cleanup_handlers) { eval { $handler->($signal); }; @@ -113,7 +113,7 @@ sub _run_cleanup_handlers( $self, $signal ) } # DESTROY runs when object goes out of scope -sub DESTROY($self) +sub DESTROY ($self) { $self->restore; } diff --git a/lib/FuguLib/State.pm b/lib/FuguLib/State.pm index 3b1f36d..2cd9f19 100644 --- a/lib/FuguLib/State.pm +++ b/lib/FuguLib/State.pm @@ -26,7 +26,7 @@ use FuguLib::Process; # # Provides safe PID file reading/writing with locking and stale PID detection. -sub new( $class, $pidfile ) +sub new ( $class, $pidfile ) { return unless defined $pidfile; @@ -39,7 +39,7 @@ sub new( $class, $pidfile ) # $self->write_pid($pid): # Write PID to file with exclusive lock # Returns 1 on success, 0 on failure -sub write_pid( $self, $pid = $$ ) +sub write_pid ( $self, $pid = $$ ) { my $pidfile = $self->{pidfile}; @@ -57,7 +57,7 @@ sub write_pid( $self, $pid = $$ ) # $self->read_pid(): # Read PID from file # Returns PID or undef if not found or invalid -sub read_pid($self) +sub read_pid ($self) { my $pidfile = $self->{pidfile}; return unless -f $pidfile; @@ -74,7 +74,7 @@ sub read_pid($self) # $self->remove(): # Remove PID file -sub remove($self) +sub remove ($self) { my $pidfile = $self->{pidfile}; return 1 unless -f $pidfile; @@ -84,7 +84,7 @@ sub remove($self) # $self->is_running(): # Check if process from PID file is running # Returns PID if running, undef otherwise -sub is_running($self) +sub is_running ($self) { my $pid = $self->read_pid; return unless defined $pid; @@ -94,7 +94,7 @@ sub is_running($self) # $self->is_stale(): # Check if PID file is stale (process not running) -sub is_stale($self) +sub is_stale ($self) { my $pid = $self->read_pid; return 0 unless defined $pid; diff --git a/lib/OpenHAP/Accessory.pm b/lib/OpenHAP/Accessory.pm index 311b7c1..a3e756d 100644 --- a/lib/OpenHAP/Accessory.pm +++ b/lib/OpenHAP/Accessory.pm @@ -2,7 +2,7 @@ use v5.36; package OpenHAP::Accessory; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { aid => $args{aid}, @@ -21,7 +21,7 @@ sub new( $class, %args ) return $self; } -sub _add_accessory_info_service($self) +sub _add_accessory_info_service ($self) { require OpenHAP::Service; @@ -89,17 +89,17 @@ sub _add_accessory_info_service($self) push @{ $self->{services} }, $info; } -sub add_service( $self, $service ) +sub add_service ( $self, $service ) { push @{ $self->{services} }, $service; } -sub get_services($self) +sub get_services ($self) { return @{ $self->{services} }; } -sub get_service( $self, $type ) +sub get_service ( $self, $type ) { # Look up the full UUID if a short name is given require OpenHAP::Service; @@ -112,7 +112,7 @@ sub get_service( $self, $type ) return; } -sub get_characteristic( $self, $iid ) +sub get_characteristic ( $self, $iid ) { for my $service ( @{ $self->{services} } ) { my $char = $service->get_characteristic($iid); @@ -122,7 +122,7 @@ sub get_characteristic( $self, $iid ) return; } -sub to_json($self) +sub to_json ($self) { my @services; for my $service ( @{ $self->{services} } ) { @@ -135,18 +135,18 @@ sub to_json($self) }; } -sub identify($self) +sub identify ($self) { # Override in subclasses to implement identify functionality # (e.g., blink LED, beep, etc.) } -sub add_event_callback( $self, $callback ) +sub add_event_callback ( $self, $callback ) { push @{ $self->{event_callbacks} }, $callback; } -sub notify_change( $self, $iid ) +sub notify_change ( $self, $iid ) { # Notify all registered callbacks about characteristic change for my $callback ( @{ $self->{event_callbacks} } ) { diff --git a/lib/OpenHAP/Bridge.pm b/lib/OpenHAP/Bridge.pm index ab9b4d6..bb412e7 100644 --- a/lib/OpenHAP/Bridge.pm +++ b/lib/OpenHAP/Bridge.pm @@ -5,7 +5,7 @@ package OpenHAP::Bridge; require OpenHAP::Accessory; our @ISA = qw(OpenHAP::Accessory); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new( aid => 1, # Bridge is always accessory 1 @@ -21,7 +21,7 @@ sub new( $class, %args ) return $self; } -sub add_bridged_accessory( $self, $accessory ) +sub add_bridged_accessory ( $self, $accessory ) { $OpenHAP::logger->debug( 'Adding bridged accessory: AID=%d, name=%s', $accessory->{aid}, $accessory->{name} ); @@ -29,22 +29,22 @@ sub add_bridged_accessory( $self, $accessory ) # Forward event callbacks $accessory->add_event_callback( - sub( $aid, $iid ) { + sub ( $aid, $iid ) { $self->notify_change($iid); } ); } -sub get_bridged_accessories($self) +sub get_bridged_accessories ($self) { return @{ $self->{bridged_accessories} }; } -sub get_all_accessories($self) +sub get_all_accessories ($self) { return ( $self, @{ $self->{bridged_accessories} } ); } -sub get_accessory( $self, $aid ) +sub get_accessory ( $self, $aid ) { return $self if $self->{aid} == $aid; @@ -55,7 +55,7 @@ sub get_accessory( $self, $aid ) return; } -sub to_json($self) +sub to_json ($self) { my @accessories; diff --git a/lib/OpenHAP/Characteristic.pm b/lib/OpenHAP/Characteristic.pm index d927419..31bcbc4 100644 --- a/lib/OpenHAP/Characteristic.pm +++ b/lib/OpenHAP/Characteristic.pm @@ -32,7 +32,7 @@ our %CHAR_TYPES = ( # _uuid_to_short($uuid) - Convert full UUID to short form for JSON # Returns short hex string for Apple UUIDs, full UUID for custom ones -sub _uuid_to_short($uuid) +sub _uuid_to_short ($uuid) { my $base = HAP_BASE_UUID; if ( $uuid =~ /^0*([0-9A-Fa-f]+)\Q$base\E$/i ) { @@ -65,7 +65,7 @@ our %PERMISSIONS = ( 'hd' => 1, # Hidden ); -sub new( $class, %args ) +sub new ( $class, %args ) { my $type = $args{type} // die "Characteristic type required"; @@ -98,7 +98,7 @@ sub new( $class, %args ) return $self; } -sub get_value($self) +sub get_value ($self) { # If there's a custom getter, use it @@ -114,7 +114,7 @@ sub get_value($self) return $self->{value}; } -sub set_value( $self, $value ) +sub set_value ( $self, $value ) { $OpenHAP::logger->debug( 'Setting characteristic IID=%d to value: %s', $self->{iid}, defined $value ? $value : 'undef' ); @@ -133,7 +133,7 @@ sub set_value( $self, $value ) } } -sub enable_events( $self, $enabled ) +sub enable_events ( $self, $enabled ) { $OpenHAP::logger->debug( 'Events %s for characteristic IID=%d', @@ -142,12 +142,12 @@ sub enable_events( $self, $enabled ) $self->{event_enabled} = $enabled; } -sub events_enabled($self) +sub events_enabled ($self) { return $self->{event_enabled}; } -sub to_json( $self, $include_value = 1 ) +sub to_json ( $self, $include_value = 1 ) { my $json = { diff --git a/lib/OpenHAP/Config.pm b/lib/OpenHAP/Config.pm index 19320c4..87e951e 100644 --- a/lib/OpenHAP/Config.pm +++ b/lib/OpenHAP/Config.pm @@ -3,7 +3,7 @@ use v5.36; package OpenHAP::Config; use Carp qw(croak); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { file => $args{file} // '/etc/openhapd.conf', @@ -13,7 +13,7 @@ sub new( $class, %args ) return $self; } -sub load($self) +sub load ($self) { my $file = $self->{file}; return unless -f $file; @@ -79,12 +79,12 @@ m/\A \s* device \s+ (\w+) \s+ (\w+) \s+ (\w+) \s* [{] /xms return $self->{config}; } -sub get( $self, $key, $default = undef ) +sub get ( $self, $key, $default = undef ) { return $self->{config}{$key} // $default; } -sub get_devices($self) +sub get_devices ($self) { return @{ $self->{config}{devices} // [] }; } diff --git a/lib/OpenHAP/Crypto.pm b/lib/OpenHAP/Crypto.pm index bb905c2..14c7266 100644 --- a/lib/OpenHAP/Crypto.pm +++ b/lib/OpenHAP/Crypto.pm @@ -29,7 +29,7 @@ our $N_3072 = pack( 'H*', . '43DB5BFCE0FD108E4B82D120A93AD2CAFFFFFFFFFFFFFFFF' ); our $g = 5; -sub generate_random_bytes($length) +sub generate_random_bytes ($length) { # Use /dev/urandom for random bytes open my $fh, '<', '/dev/urandom' or do { @@ -55,12 +55,12 @@ sub generate_keypair_ed25519() return ( $secret_key, $public_key ); } -sub sign_ed25519( $message, $secret_key, $public_key ) +sub sign_ed25519 ( $message, $secret_key, $public_key ) { return Crypt::Ed25519::sign( $message, $public_key, $secret_key ); } -sub verify_ed25519( $signature, $message, $public_key ) +sub verify_ed25519 ( $signature, $message, $public_key ) { return Crypt::Ed25519::verify( $message, $public_key, $signature ); } @@ -73,18 +73,18 @@ sub generate_keypair_x25519() return ( $secret, $public ); } -sub derive_shared_secret( $our_secret, $their_public ) +sub derive_shared_secret ( $our_secret, $their_public ) { return Crypt::Curve25519::curve25519_shared_secret( $our_secret, $their_public ); } -sub hkdf_sha512( $ikm, $salt, $info, $length ) +sub hkdf_sha512 ( $ikm, $salt, $info, $length ) { return hkdf( $ikm, $salt, 'SHA512', $length, $info ); } -sub chacha20_poly1305_encrypt( $key, $nonce, $plaintext, $aad = '' ) +sub chacha20_poly1305_encrypt ( $key, $nonce, $plaintext, $aad = '' ) { my ( $ciphertext, $tag ) = chacha20poly1305_encrypt_authenticate( $key, $nonce, $aad, @@ -93,7 +93,7 @@ sub chacha20_poly1305_encrypt( $key, $nonce, $plaintext, $aad = '' ) return ( $ciphertext, $tag ); } -sub chacha20_poly1305_decrypt( $key, $nonce, $ciphertext, $tag, $aad = '' ) +sub chacha20_poly1305_decrypt ( $key, $nonce, $ciphertext, $tag, $aad = '' ) { my $plaintext = chacha20poly1305_decrypt_verify( $key, $nonce, $aad, $ciphertext, diff --git a/lib/OpenHAP/Daemon.pm b/lib/OpenHAP/Daemon.pm index c0f0ee1..4104653 100644 --- a/lib/OpenHAP/Daemon.pm +++ b/lib/OpenHAP/Daemon.pm @@ -27,7 +27,7 @@ use FuguLib::State; # Fork into background, detach from terminal, and redirect # standard file descriptors. Returns in child process only. # Parent process exits successfully. -sub daemonize( $class, $logfile = '/var/log/openhapd.log' ) +sub daemonize ( $class, $logfile = '/var/log/openhapd.log' ) { FuguLib::Daemon->daemonize( logfile => $logfile ); $OpenHAP::logger->debug( 'Daemonized successfully, PID: %d', $$ ) @@ -37,7 +37,7 @@ sub daemonize( $class, $logfile = '/var/log/openhapd.log' ) # $class->write_pidfile($path): # Write current PID to file. Returns true on success. -sub write_pidfile( $class, $path ) +sub write_pidfile ( $class, $path ) { my $state = FuguLib::State->new( pidfile => $path ); unless ( $state->write_pid($$) ) { @@ -53,7 +53,7 @@ sub write_pidfile( $class, $path ) # $class->read_pidfile($path): # Read PID from file. Returns PID or undef if file doesn't exist # or cannot be read. -sub read_pidfile( $class, $path ) +sub read_pidfile ( $class, $path ) { my $state = FuguLib::State->new( pidfile => $path ); my $pid = $state->read_pid(); @@ -63,7 +63,7 @@ sub read_pidfile( $class, $path ) # $class->check_running($pidfile): # Check if daemon is running based on PID file. # Returns PID if running, undef otherwise. -sub check_running( $class, $pidfile ) +sub check_running ( $class, $pidfile ) { my $state = FuguLib::State->new($pidfile); return $state->is_running() ? $state->read_pid() : undef; diff --git a/lib/OpenHAP/DeviceLoader.pm b/lib/OpenHAP/DeviceLoader.pm index 7fc6711..25aaff3 100644 --- a/lib/OpenHAP/DeviceLoader.pm +++ b/lib/OpenHAP/DeviceLoader.pm @@ -26,7 +26,7 @@ use OpenHAP::Tasmota::Lightbulb; # $class->new(): # Create new device loader instance. -sub new($class) +sub new ($class) { bless { next_aid => 2, # AID 1 is the bridge @@ -37,7 +37,7 @@ sub new($class) # $self->load_devices($config, $hap, $mqtt): # Load devices from configuration and add them to HAP bridge. # Returns number of successfully loaded devices. -sub load_devices( $self, $config, $hap, $mqtt ) +sub load_devices ( $self, $config, $hap, $mqtt ) { my @devices = $config->get_devices(); $OpenHAP::logger->debug( 'Loading %d device(s) from configuration', @@ -69,7 +69,7 @@ sub load_devices( $self, $config, $hap, $mqtt ) # $self->get_devices(): # Return list of loaded device accessory objects. -sub get_devices($self) +sub get_devices ($self) { return @{ $self->{devices} }; } @@ -77,7 +77,7 @@ sub get_devices($self) # $self->_create_device($device, $mqtt, $mqtt_connected): # Create accessory from device configuration. # Returns accessory object or undef on error. -sub _create_device( $self, $device, $mqtt, $mqtt_connected ) +sub _create_device ( $self, $device, $mqtt, $mqtt_connected ) { my $dev_type = $device->{type} // 'unknown'; my $dev_subtype = $device->{subtype} // 'unknown'; @@ -128,7 +128,7 @@ sub _create_device( $self, $device, $mqtt, $mqtt_connected ) # $self->_is_supported_device($type, $subtype): # Check if device type is supported. -sub _is_supported_device( $self, $type, $subtype ) +sub _is_supported_device ( $self, $type, $subtype ) { return 1 if $type eq 'tasmota' && $subtype eq 'thermostat'; return 1 if $type eq 'tasmota' && $subtype eq 'heater'; @@ -143,7 +143,7 @@ sub _is_supported_device( $self, $type, $subtype ) # $self->_validate_device($device): # Validate required device fields. Returns true if valid. -sub _validate_device( $self, $device ) +sub _validate_device ( $self, $device ) { unless ( defined $device->{name} && $device->{name} ne '' ) { $OpenHAP::logger->error('Device missing required field: name'); @@ -169,7 +169,7 @@ sub _validate_device( $self, $device ) # $self->_instantiate_device($device, $mqtt, $type, $subtype): # Instantiate device object based on type. -sub _instantiate_device( $self, $device, $mqtt, $type, $subtype ) +sub _instantiate_device ( $self, $device, $mqtt, $type, $subtype ) { my %common_args = ( aid => $self->{next_aid}++, @@ -228,7 +228,7 @@ sub _instantiate_device( $self, $device, $mqtt, $type, $subtype ) # $self->_subscribe_mqtt($accessory, $device): # Subscribe device to MQTT topics. -sub _subscribe_mqtt( $self, $accessory, $device ) +sub _subscribe_mqtt ( $self, $accessory, $device ) { eval { $accessory->subscribe_mqtt(); }; if ($@) { @@ -244,7 +244,7 @@ sub _subscribe_mqtt( $self, $accessory, $device ) # $self->_device_type_name($device): # Return human-readable device type name. -sub _device_type_name( $self, $device ) +sub _device_type_name ( $self, $device ) { my $type = $device->{type} // 'unknown'; my $subtype = $device->{subtype} // 'unknown'; diff --git a/lib/OpenHAP/HAP.pm b/lib/OpenHAP/HAP.pm index 9f9d73a..57cd72f 100644 --- a/lib/OpenHAP/HAP.pm +++ b/lib/OpenHAP/HAP.pm @@ -16,7 +16,7 @@ use OpenHAP::Crypto; use OpenHAP::Bridge; use OpenHAP::PIN qw(normalize_pin); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { port => $args{port} // 51827, @@ -47,7 +47,7 @@ sub new( $class, %args ) return $self; } -sub _initialize($self) +sub _initialize ($self) { # Initialize storage $self->{storage} = @@ -75,14 +75,14 @@ sub _initialize($self) $self->{bridge} = OpenHAP::Bridge->new( name => $self->{name}, ); } -sub add_accessory( $self, $accessory ) +sub add_accessory ( $self, $accessory ) { $self->{bridge}->add_bridged_accessory($accessory); } # $self->_mqtt_resubscribe_accessories(): # resubscribe all accessories to their MQTT topics -sub _mqtt_resubscribe_accessories($self) +sub _mqtt_resubscribe_accessories ($self) { my @accessories = $self->{bridge}->get_bridged_accessories(); for my $acc (@accessories) { @@ -97,12 +97,12 @@ sub _mqtt_resubscribe_accessories($self) # $self->set_mqtt_client($mqtt): # set the MQTT client for event loop integration -sub set_mqtt_client( $self, $mqtt ) +sub set_mqtt_client ( $self, $mqtt ) { $self->{mqtt_client} = $mqtt; } -sub run($self) +sub run ($self) { my $server = IO::Socket::INET->new( LocalPort => $self->{port}, @@ -183,14 +183,14 @@ sub run($self) } } -sub _init_session( $self, $socket ) +sub _init_session ( $self, $socket ) { $OpenHAP::logger->info( 'Client connected from %s', $socket->peerhost ); $self->{sessions}{$socket} = OpenHAP::Session->new( socket => $socket, ); } -sub _handle_client( $self, $sock, $select ) +sub _handle_client ( $self, $sock, $select ) { my $session = $self->{sessions}{$sock}; my $data = ''; @@ -241,7 +241,7 @@ sub _handle_client( $self, $sock, $select ) $sock->syswrite($response); } -sub _dispatch( $self, $request, $session ) +sub _dispatch ( $self, $request, $session ) { my $path = $request->{path}; my $method = $request->{method}; @@ -305,7 +305,7 @@ sub _dispatch( $self, $request, $session ) ); } -sub _handle_pair_setup( $self, $request, $session ) +sub _handle_pair_setup ( $self, $request, $session ) { $OpenHAP::logger->debug('Handling pair-setup request'); my $response_body = @@ -318,7 +318,7 @@ sub _handle_pair_setup( $self, $request, $session ) ); } -sub _handle_pair_verify( $self, $request, $session ) +sub _handle_pair_verify ( $self, $request, $session ) { $OpenHAP::logger->debug('Handling pair-verify request'); my $response_body = @@ -331,7 +331,7 @@ sub _handle_pair_verify( $self, $request, $session ) ); } -sub _handle_accessories( $self, $request, $session ) +sub _handle_accessories ( $self, $request, $session ) { my $json = encode_json( $self->{bridge}->to_json() ); @@ -342,7 +342,7 @@ sub _handle_accessories( $self, $request, $session ) ); } -sub _handle_characteristics_get( $self, $request, $session ) +sub _handle_characteristics_get ( $self, $request, $session ) { # Parse query string: ?id=1.11,1.13&meta=1&perms=1&type=1&ev=1 my $query = $request->{path}; @@ -437,7 +437,7 @@ sub _handle_characteristics_get( $self, $request, $session ) ); } -sub _handle_characteristics_put( $self, $request, $session ) +sub _handle_characteristics_put ( $self, $request, $session ) { $OpenHAP::logger->debug('Writing characteristics'); my $data = eval { decode_json( $request->{body} ) }; @@ -548,7 +548,7 @@ sub _handle_characteristics_put( $self, $request, $session ) ); } -sub _handle_identify( $self, $request, $session ) +sub _handle_identify ( $self, $request, $session ) { # Identify is only allowed for unpaired accessories if ( $self->is_paired() ) { @@ -578,7 +578,7 @@ sub _handle_identify( $self, $request, $session ) return OpenHAP::HTTP::build_response( status => 204 ); } -sub _handle_pairings( $self, $request, $session ) +sub _handle_pairings ( $self, $request, $session ) { my %tlv = OpenHAP::TLV::decode( $request->{body} ); @@ -612,7 +612,7 @@ sub _handle_pairings( $self, $request, $session ) ); } -sub _handle_add_pairing( $self, $tlv, $session ) +sub _handle_add_pairing ( $self, $tlv, $session ) { my $identifier = $tlv->{ OpenHAP::Pairing::kTLVType_Identifier() }; my $ltpk = $tlv->{ OpenHAP::Pairing::kTLVType_PublicKey() }; @@ -658,7 +658,7 @@ sub _handle_add_pairing( $self, $tlv, $session ) ); } -sub _handle_remove_pairing( $self, $tlv, $session ) +sub _handle_remove_pairing ( $self, $tlv, $session ) { my $identifier = $tlv->{ OpenHAP::Pairing::kTLVType_Identifier() }; @@ -713,7 +713,7 @@ sub _handle_remove_pairing( $self, $tlv, $session ) ); } -sub _handle_list_pairings( $self, $tlv, $session ) +sub _handle_list_pairings ( $self, $tlv, $session ) { $OpenHAP::logger->debug('List pairings request'); @@ -767,7 +767,7 @@ sub _handle_list_pairings( $self, $tlv, $session ) ); } -sub _handle_prepare( $self, $request, $session ) +sub _handle_prepare ( $self, $request, $session ) { $OpenHAP::logger->debug('Timed write prepare request'); my $data = eval { decode_json( $request->{body} ) }; @@ -804,14 +804,14 @@ sub _handle_prepare( $self, $request, $session ) } # Event subscription tracking -sub _register_event_subscription( $self, $session, $aid, $iid ) +sub _register_event_subscription ( $self, $session, $aid, $iid ) { my $key = "$aid.$iid"; $self->{event_subscriptions}{$key}{$session} = $session; $OpenHAP::logger->debug( 'Registered event subscription for %s', $key ); } -sub _unregister_event_subscription( $self, $session, $aid, $iid ) +sub _unregister_event_subscription ( $self, $session, $aid, $iid ) { my $key = "$aid.$iid"; delete $self->{event_subscriptions}{$key}{$session}; @@ -830,7 +830,7 @@ use constant IMMEDIATE_EVENT_TYPES => { use constant EVENT_COALESCE_DELAY => 0.250; # Queue an event for delivery, with coalescing for non-button events -sub queue_event( $self, $aid, $iid, $value ) +sub queue_event ( $self, $aid, $iid, $value ) { my $accessory = $self->{bridge}->get_accessory($aid); return unless $accessory; @@ -862,7 +862,7 @@ sub queue_event( $self, $aid, $iid, $value ) } # Flush queued events (called from event loop) -sub flush_events($self) +sub flush_events ($self) { return unless $self->{event_flush_scheduled}; @@ -884,7 +884,7 @@ sub flush_events($self) } # Send EVENT/1.0 notification to subscribed sessions -sub send_event( $self, $aid, $iid, $value ) +sub send_event ( $self, $aid, $iid, $value ) { my $key = "$aid.$iid"; my $subs = $self->{event_subscriptions}{$key} // {}; @@ -917,25 +917,25 @@ sub send_event( $self, $aid, $iid, $value ) } } -sub is_paired($self) +sub is_paired ($self) { my $pairings = $self->{storage}->load_pairings(); return scalar( keys %$pairings ) > 0; } -sub get_config_number($self) +sub get_config_number ($self) { return $self->{storage}->get_config_number(); } -sub get_device_id($self) +sub get_device_id ($self) { # Generate a device ID from the public key (uppercase MAC format) my $id = uc( unpack( 'H*', substr( $self->{accessory_ltpk}, 0, 6 ) ) ); return join( ':', $id =~ /../g ); } -sub get_mdns_txt_records($self) +sub get_mdns_txt_records ($self) { # Note: pv=1 instead of 1.1 because mdnsd uses '.' as TXT record # delimiter and doesn't support escaping. HomeKit accepts pv=1. @@ -960,7 +960,7 @@ sub get_mdns_txt_records($self) # _get_setup_hash() - Calculate setup hash for mDNS # Hash is Base64 of first 4 bytes of SHA-512(setupID + deviceID.toUpperCase()) -sub _get_setup_hash($self) +sub _get_setup_hash ($self) { my $setup_id = $self->{setup_id}; my $device_id = $self->get_device_id(); # Already uppercase @@ -975,7 +975,7 @@ sub _get_setup_hash($self) # _regenerate_identity() - Generate new accessory keys after factory reset # Called when last admin pairing is removed (HAP-Pairing.md §7.2) -sub _regenerate_identity($self) +sub _regenerate_identity ($self) { my ( $ltsk, $ltpk ) = OpenHAP::Crypto::generate_keypair_ed25519(); $self->{storage}->save_accessory_keys( $ltsk, $ltpk ); diff --git a/lib/OpenHAP/HTTP.pm b/lib/OpenHAP/HTTP.pm index 426bf7f..e6581aa 100644 --- a/lib/OpenHAP/HTTP.pm +++ b/lib/OpenHAP/HTTP.pm @@ -5,7 +5,7 @@ package OpenHAP::HTTP; # Simple HTTP/1.1 parser for HAP protocol # HAP uses a variant of HTTP/1.1 with some differences -sub parse($data) +sub parse ($data) { my $request = { method => '', @@ -44,7 +44,7 @@ sub parse($data) return $request; } -sub build_response(%args) +sub build_response (%args) { my $status = $args{status} // 200; my $status_text = $args{status_text} // _status_text($status); @@ -74,7 +74,7 @@ sub build_response(%args) return $response; } -sub _status_text($code) +sub _status_text ($code) { my %codes = ( 200 => 'OK', diff --git a/lib/OpenHAP/MDNS.pm b/lib/OpenHAP/MDNS.pm index 29e9def..1e097b0 100644 --- a/lib/OpenHAP/MDNS.pm +++ b/lib/OpenHAP/MDNS.pm @@ -26,7 +26,7 @@ use FuguLib::Process; # This module wraps OpenBSD's mdnsctl(8) command to register HAP services # with mdnsd(8) for Bonjour/mDNS service discovery. -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { service_name => $args{service_name} // 'OpenHAP Bridge', @@ -63,7 +63,7 @@ sub _find_mdnsctl() # Register the HAP service with mdnsd via mdnsctl # Forks a background process to keep the service registered # Returns 1 on success, undef on failure (logs warning) -sub register_service($self) +sub register_service ($self) { return if $self->{registered}; @@ -119,12 +119,12 @@ sub register_service($self) check_alive => 1, stdout => $mdns_log, stderr => $mdns_log, - on_success => sub($pid) { + on_success => sub ($pid) { $OpenHAP::logger->info( 'Registered mDNS service: %s._hap._tcp port %d (PID: %d)', $self->{service_name}, $self->{port}, $pid ); }, - on_error => sub($err) { + on_error => sub ($err) { $OpenHAP::logger->warning( 'mDNS registration failed: %s', $err ); }, @@ -143,7 +143,7 @@ sub register_service($self) # $self->unregister_service(): # Unregister the HAP service by killing the mdnsctl process # Returns 1 on success -sub unregister_service($self) +sub unregister_service ($self) { return if !$self->{registered}; @@ -173,7 +173,7 @@ sub unregister_service($self) # $self->is_registered(): # Check if service is currently registered -sub is_registered($self) +sub is_registered ($self) { return $self->{registered}; } diff --git a/lib/OpenHAP/MQTT.pm b/lib/OpenHAP/MQTT.pm index ba04996..726b068 100644 --- a/lib/OpenHAP/MQTT.pm +++ b/lib/OpenHAP/MQTT.pm @@ -5,7 +5,7 @@ package OpenHAP::MQTT; # MQTT client wrapper for OpenHAP # Integrates with IO::Select for event-driven message handling -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { host => $args{host} // '127.0.0.1', @@ -22,7 +22,7 @@ sub new( $class, %args ) return $self; } -sub mqtt_connect( $self, $timeout = 10 ) +sub mqtt_connect ( $self, $timeout = 10 ) { $OpenHAP::logger->debug( 'Connecting to MQTT broker at %s:%d (timeout: %ds)', @@ -94,7 +94,7 @@ sub mqtt_connect( $self, $timeout = 10 ) # $self->subscribe($topic, $callback): # subscribe to an MQTT topic with a callback for messages # $callback receives ($topic, $payload) -sub subscribe( $self, $topic, $callback ) +sub subscribe ( $self, $topic, $callback ) { $OpenHAP::logger->debug( 'Subscribing to MQTT topic: %s', $topic ); $self->{subscriptions}{$topic} = $callback; @@ -106,7 +106,7 @@ sub subscribe( $self, $topic, $callback ) eval { $self->{client}->subscribe( $topic, - sub( $topic_received, $payload ) { + sub ( $topic_received, $payload ) { push @{ $self->{pending_messages} }, [ $topic_received, $payload ]; } ); @@ -120,7 +120,7 @@ sub subscribe( $self, $topic, $callback ) # $self->unsubscribe($topic): # unsubscribe from an MQTT topic -sub unsubscribe( $self, $topic ) +sub unsubscribe ( $self, $topic ) { delete $self->{subscriptions}{$topic}; @@ -129,7 +129,7 @@ sub unsubscribe( $self, $topic ) eval { $self->{client}->unsubscribe($topic); }; } -sub publish( $self, $topic, $payload, $retain = 0 ) +sub publish ( $self, $topic, $payload, $retain = 0 ) { return unless $self->{connected} && $self->{client}; @@ -158,7 +158,7 @@ sub publish( $self, $topic, $payload, $retain = 0 ) # process pending MQTT messages, call from main event loop # $timeout is maximum seconds to wait (default 0 = non-blocking) # returns number of messages processed -sub tick( $self, $timeout = 0 ) +sub tick ( $self, $timeout = 0 ) { return 0 unless $self->{connected} && $self->{client}; @@ -210,7 +210,7 @@ sub tick( $self, $timeout = 0 ) # $self->_dispatch_message($topic, $payload): # dispatch a message to matching subscription callbacks # $callback receives ($topic, $payload) - topic is the actual received topic -sub _dispatch_message( $self, $topic, $payload ) +sub _dispatch_message ( $self, $topic, $payload ) { my $dispatched = 0; @@ -233,7 +233,7 @@ sub _dispatch_message( $self, $topic, $payload ) # $self->_topic_matches($pattern, $topic): # check if a topic matches a subscription pattern # supports + (single level) and # (multi level) wildcards -sub _topic_matches( $self, $pattern, $topic ) +sub _topic_matches ( $self, $pattern, $topic ) { # Exact match return 1 if $pattern eq $topic; @@ -266,7 +266,7 @@ sub _topic_matches( $self, $pattern, $topic ) # $self->resubscribe(): # resubscribe to all topics after reconnection -sub resubscribe($self) +sub resubscribe ($self) { return unless $self->{connected} && $self->{client}; @@ -275,7 +275,7 @@ sub resubscribe($self) eval { $self->{client}->subscribe( $topic, - sub( $topic_received, $payload ) { + sub ( $topic_received, $payload ) { push @{ $self->{pending_messages} }, [ $topic_received, $payload ]; } ); @@ -291,7 +291,7 @@ sub resubscribe($self) # $self->reconnect(): # attempt to reconnect to the broker # returns 1 on success, 0 on failure -sub reconnect($self) +sub reconnect ($self) { $OpenHAP::logger->debug('Attempting MQTT reconnection'); $self->disconnect(); @@ -305,7 +305,7 @@ sub reconnect($self) return 0; } -sub disconnect($self) +sub disconnect ($self) { if ( $self->{connected} && $self->{client} ) { eval { $self->{client}->disconnect(); }; @@ -315,14 +315,14 @@ sub disconnect($self) $self->{pending_messages} = []; } -sub is_connected($self) +sub is_connected ($self) { return $self->{connected}; } # $self->subscriptions(): # return list of subscribed topics -sub subscriptions($self) +sub subscriptions ($self) { return keys %{ $self->{subscriptions} }; } diff --git a/lib/OpenHAP/PIN.pm b/lib/OpenHAP/PIN.pm index 7e356c0..db5347e 100644 --- a/lib/OpenHAP/PIN.pm +++ b/lib/OpenHAP/PIN.pm @@ -32,7 +32,7 @@ use constant INVALID_PINS => qw( # normalize_pin($pin): # Strip dashes and spaces from PIN for internal use # Returns: 8-digit numeric string or undef if invalid format -sub normalize_pin($pin) +sub normalize_pin ($pin) { return unless defined $pin; @@ -48,7 +48,7 @@ sub normalize_pin($pin) # validate_pin($pin): # Validate PIN meets HAP requirements # Returns: 1 if valid, undef if invalid -sub validate_pin($pin) +sub validate_pin ($pin) { # Normalize first my $normalized = normalize_pin($pin); diff --git a/lib/OpenHAP/Pairing.pm b/lib/OpenHAP/Pairing.pm index ef1b7fc..b4a8803 100644 --- a/lib/OpenHAP/Pairing.pm +++ b/lib/OpenHAP/Pairing.pm @@ -48,7 +48,7 @@ our $pairing_in_progress = 0; our $pairing_session_id = undef; our $failed_auth_attempts = 0; -sub new( $class, %args ) +sub new ( $class, %args ) { my $pin = normalize_pin( $args{pin} ) // die "PIN required"; @@ -64,7 +64,7 @@ sub new( $class, %args ) # clear_pairing_state() - Reset global pairing state # Called after successful pairing or on connection close -sub clear_pairing_state( $class_or_self, $session = undef ) +sub clear_pairing_state ( $class_or_self, $session = undef ) { # Only clear if this session owns the lock or no session specified if ( !defined $session @@ -78,25 +78,25 @@ sub clear_pairing_state( $class_or_self, $session = undef ) # reset_auth_attempts() - Reset failed authentication counter # Called after successful pairing or administratively -sub reset_auth_attempts($class_or_self) +sub reset_auth_attempts ($class_or_self) { $failed_auth_attempts = 0; } # get_failed_attempts() - Get current failed attempt count (for testing) -sub get_failed_attempts($class_or_self) +sub get_failed_attempts ($class_or_self) { return $failed_auth_attempts; } # _get_accessory_pairing_id() - Generate MAC-like pairing ID from public key -sub _get_accessory_pairing_id($self) +sub _get_accessory_pairing_id ($self) { my $id = uc( unpack( 'H*', substr( $self->{accessory_ltpk}, 0, 6 ) ) ); return join( ':', $id =~ /../g ); } -sub handle_pair_setup( $self, $body, $session ) +sub handle_pair_setup ( $self, $body, $session ) { my %request = OpenHAP::TLV::decode($body); @@ -123,7 +123,7 @@ sub handle_pair_setup( $self, $body, $session ) return $self->_error_response( kTLVError_Unknown, 2 ); } -sub _pair_setup_m1_m2( $self, $session, $method = 0 ) +sub _pair_setup_m1_m2 ( $self, $session, $method = 0 ) { # Check if max authentication attempts exceeded (HAP-Pairing.md §8) if ( $failed_auth_attempts >= MAX_AUTH_ATTEMPTS ) { @@ -177,7 +177,7 @@ sub _pair_setup_m1_m2( $self, $session, $method = 0 ) return $response; } -sub _pair_setup_m3_m4( $self, $request, $session ) +sub _pair_setup_m3_m4 ( $self, $request, $session ) { my $srp = $session->{pairing_state}{srp}; @@ -221,7 +221,7 @@ sub _pair_setup_m3_m4( $self, $request, $session ) return $response; } -sub _pair_setup_m5_m6( $self, $request, $session ) +sub _pair_setup_m5_m6 ( $self, $request, $session ) { my $srp = $session->{pairing_state}{srp}; @@ -315,7 +315,7 @@ sub _pair_setup_m5_m6( $self, $request, $session ) return $response; } -sub handle_pair_verify( $self, $body, $session ) +sub handle_pair_verify ( $self, $body, $session ) { my %request = OpenHAP::TLV::decode($body); @@ -332,7 +332,7 @@ sub handle_pair_verify( $self, $body, $session ) return $self->_error_response( kTLVError_Unknown, 2 ); } -sub _pair_verify_m1_m2( $self, $request, $session ) +sub _pair_verify_m1_m2 ( $self, $request, $session ) { my $ios_public_key = $request->{ kTLVType_PublicKey() }; @@ -387,7 +387,7 @@ sub _pair_verify_m1_m2( $self, $request, $session ) return $response; } -sub _pair_verify_m3_m4( $self, $request, $session ) +sub _pair_verify_m3_m4 ( $self, $request, $session ) { my $encrypted_data = $request->{ kTLVType_EncryptedData() }; @@ -454,7 +454,7 @@ sub _pair_verify_m3_m4( $self, $request, $session ) return $response; } -sub _error_response( $self, $error_code, $state ) +sub _error_response ( $self, $error_code, $state ) { return OpenHAP::TLV::encode( diff --git a/lib/OpenHAP/SRP.pm b/lib/OpenHAP/SRP.pm index b977849..9249ce5 100644 --- a/lib/OpenHAP/SRP.pm +++ b/lib/OpenHAP/SRP.pm @@ -14,7 +14,7 @@ use constant N_LEN => 384; # _bigint_to_bytes($bigint, $length = undef) - Convert BigInt to bytes # Strips '0x' prefix from as_hex() and optionally pads to fixed length -sub _bigint_to_bytes( $bigint, $length = undef ) +sub _bigint_to_bytes ( $bigint, $length = undef ) { my $hex = $bigint->as_hex(); $hex =~ s/^0x//; # Strip 0x prefix @@ -32,7 +32,7 @@ sub _bigint_to_bytes( $bigint, $length = undef ) return $bytes; } -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { @@ -60,13 +60,13 @@ sub new( $class, %args ) return $self; } -sub generate_salt($self) +sub generate_salt ($self) { $self->{salt} = OpenHAP::Crypto::generate_random_bytes(16); return $self->{salt}; } -sub compute_verifier( $self, $salt = undef, $password = undef ) +sub compute_verifier ( $self, $salt = undef, $password = undef ) { $salt //= $self->{salt}; $password //= $self->{password}; @@ -83,7 +83,7 @@ sub compute_verifier( $self, $salt = undef, $password = undef ) return $v; } -sub generate_server_public($self) +sub generate_server_public ($self) { # Generate random b (256 bits) @@ -107,7 +107,7 @@ sub generate_server_public($self) return $B; } -sub compute_session_key( $self, $A_bytes ) +sub compute_session_key ( $self, $A_bytes ) { my $A = Math::BigInt->from_hex( unpack( 'H*', $A_bytes ) ); @@ -139,7 +139,7 @@ sub compute_session_key( $self, $A_bytes ) return $self->{K}; } -sub verify_client_proof( $self, $M1_client ) +sub verify_client_proof ( $self, $M1_client ) { # M1 = H(H(N) XOR H(g) | H(username) | salt | A | B | K) @@ -167,7 +167,7 @@ sub verify_client_proof( $self, $M1_client ) return $M1 eq $M1_client; } -sub generate_server_proof($self) +sub generate_server_proof ($self) { die "SRP: M1 not set (verify_client_proof not called)" if !defined $self->{M1}; @@ -183,7 +183,7 @@ sub generate_server_proof($self) return $M2; } -sub get_session_key($self) +sub get_session_key ($self) { return $self->{K}; } diff --git a/lib/OpenHAP/Service.pm b/lib/OpenHAP/Service.pm index d5536df..821b033 100644 --- a/lib/OpenHAP/Service.pm +++ b/lib/OpenHAP/Service.pm @@ -16,7 +16,7 @@ our %SERVICE_TYPES = ( # _uuid_to_short($uuid) - Convert full UUID to short form for JSON # Returns short hex string for Apple UUIDs, full UUID for custom ones -sub _uuid_to_short($uuid) +sub _uuid_to_short ($uuid) { my $base = HAP_BASE_UUID; if ( $uuid =~ /^0*([0-9A-Fa-f]+)\Q$base\E$/i ) { @@ -25,7 +25,7 @@ sub _uuid_to_short($uuid) return $uuid; } -sub new( $class, %args ) +sub new ( $class, %args ) { my $type = $args{type} // die "Service type required"; @@ -42,12 +42,12 @@ sub new( $class, %args ) return $self; } -sub add_characteristic( $self, $characteristic ) +sub add_characteristic ( $self, $characteristic ) { push @{ $self->{characteristics} }, $characteristic; } -sub get_characteristic( $self, $iid ) +sub get_characteristic ( $self, $iid ) { for my $char ( @{ $self->{characteristics} } ) { @@ -57,7 +57,7 @@ sub get_characteristic( $self, $iid ) return; } -sub get_characteristic_by_type( $self, $type ) +sub get_characteristic_by_type ( $self, $type ) { require OpenHAP::Characteristic; my $target_uuid = $OpenHAP::Characteristic::CHAR_TYPES{$type} // $type; @@ -69,12 +69,12 @@ sub get_characteristic_by_type( $self, $type ) return; } -sub get_characteristics($self) +sub get_characteristics ($self) { return @{ $self->{characteristics} }; } -sub to_json($self) +sub to_json ($self) { my @chars; diff --git a/lib/OpenHAP/Session.pm b/lib/OpenHAP/Session.pm index 6512ef3..c6b29ba 100644 --- a/lib/OpenHAP/Session.pm +++ b/lib/OpenHAP/Session.pm @@ -3,7 +3,7 @@ use v5.36; package OpenHAP::Session; use OpenHAP::Crypto; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { @@ -27,7 +27,7 @@ sub new( $class, %args ) return $self; } -sub set_encryption( $self, $encrypt_key, $decrypt_key ) +sub set_encryption ( $self, $encrypt_key, $decrypt_key ) { $self->{encrypt_key} = $encrypt_key; @@ -38,7 +38,7 @@ sub set_encryption( $self, $encrypt_key, $decrypt_key ) $OpenHAP::logger->debug('Session encryption enabled'); } -sub encrypt( $self, $data ) +sub encrypt ( $self, $data ) { return $data unless $self->{encrypted}; @@ -68,7 +68,7 @@ sub encrypt( $self, $data ) return $encrypted; } -sub decrypt( $self, $data ) +sub decrypt ( $self, $data ) { return $data unless $self->{encrypted}; @@ -106,17 +106,17 @@ sub decrypt( $self, $data ) return $decrypted; } -sub is_encrypted($self) +sub is_encrypted ($self) { return $self->{encrypted}; } -sub is_verified($self) +sub is_verified ($self) { return $self->{verified}; } -sub set_verified( $self, $controller_id ) +sub set_verified ( $self, $controller_id ) { $self->{verified} = 1; $self->{controller_id} = $controller_id; @@ -126,7 +126,7 @@ sub set_verified( $self, $controller_id ) return; } -sub controller_id($self) +sub controller_id ($self) { return $self->{controller_id}; } diff --git a/lib/OpenHAP/Storage.pm b/lib/OpenHAP/Storage.pm index 6365877..df2a3bd 100644 --- a/lib/OpenHAP/Storage.pm +++ b/lib/OpenHAP/Storage.pm @@ -6,7 +6,7 @@ use Carp qw(croak); use File::Path qw(make_path); use Fcntl qw(:flock); -sub new( $class, %args ) +sub new ( $class, %args ) { my $db_path = $args{db_path} // '/var/db/openhapd'; @@ -24,7 +24,7 @@ sub new( $class, %args ) return $self; } -sub load_accessory_keys($self) +sub load_accessory_keys ($self) { if ( -f $self->{accessory_ltsk_file} && -f $self->{accessory_ltpk_file} ) @@ -39,7 +39,7 @@ sub load_accessory_keys($self) return (); } -sub save_accessory_keys( $self, $ltsk, $ltpk ) +sub save_accessory_keys ( $self, $ltsk, $ltpk ) { $OpenHAP::logger->debug('Generating and saving new accessory keys'); $self->_write_file( $self->{accessory_ltsk_file}, $ltsk, 0600 ); @@ -48,7 +48,7 @@ sub save_accessory_keys( $self, $ltsk, $ltpk ) return; } -sub load_pairings($self) +sub load_pairings ($self) { return {} unless -f $self->{pairings_file}; @@ -85,7 +85,7 @@ sub load_pairings($self) return \%pairings; } -sub save_pairing( $self, $controller_id, $ltpk, $permissions = 1 ) +sub save_pairing ( $self, $controller_id, $ltpk, $permissions = 1 ) { $OpenHAP::logger->debug( 'Saving pairing for controller: %s', $controller_id ); @@ -101,7 +101,7 @@ sub save_pairing( $self, $controller_id, $ltpk, $permissions = 1 ) return; } -sub remove_pairing( $self, $controller_id ) +sub remove_pairing ( $self, $controller_id ) { $OpenHAP::logger->debug( 'Removing pairing for controller: %s', $controller_id ); @@ -116,7 +116,7 @@ sub remove_pairing( $self, $controller_id ) # remove_all_pairings() - Remove all pairings (factory reset) # Called when last admin pairing is removed (HAP-Pairing.md §7.2) -sub remove_all_pairings($self) +sub remove_all_pairings ($self) { $OpenHAP::logger->debug('Removing all pairings'); $self->_save_pairings( {} ); @@ -125,7 +125,7 @@ sub remove_all_pairings($self) return; } -sub _save_pairings( $self, $pairings ) +sub _save_pairings ( $self, $pairings ) { my $old_umask = umask(0077); open my $fh, '>', $self->{pairings_file} or do { @@ -160,7 +160,7 @@ sub _save_pairings( $self, $pairings ) return; } -sub get_config_number($self) +sub get_config_number ($self) { my $config_file = "$self->{db_path}/config_number"; if ( -f $config_file ) { @@ -172,7 +172,7 @@ sub get_config_number($self) return 1; } -sub increment_config_number($self) +sub increment_config_number ($self) { my $num = $self->get_config_number + 1; my $config_file = "$self->{db_path}/config_number"; @@ -181,7 +181,7 @@ sub increment_config_number($self) return $num; } -sub _read_file( $self, $path ) +sub _read_file ( $self, $path ) { open my $fh, '<', $path or croak "Cannot open $path: $!"; local $/ = undef; @@ -191,7 +191,7 @@ sub _read_file( $self, $path ) return $content; } -sub _write_file( $self, $path, $content, $mode = undef ) +sub _write_file ( $self, $path, $content, $mode = undef ) { open my $fh, '>', $path or croak "Cannot open $path: $!"; print $fh $content; diff --git a/lib/OpenHAP/TLV.pm b/lib/OpenHAP/TLV.pm index baea32a..3070cd0 100644 --- a/lib/OpenHAP/TLV.pm +++ b/lib/OpenHAP/TLV.pm @@ -12,7 +12,7 @@ use constant kTLVType_Separator => 0xFF; # encode(@items) - Encode type-value pairs in order # Takes a list of type, value pairs preserving insertion order # Example: encode(0x06, $state, 0x03, $pubkey) -sub encode(@items) +sub encode (@items) { my $out = ''; @@ -45,7 +45,7 @@ sub encode_separator() return pack( 'CC', kTLVType_Separator, 0 ); } -sub decode($data) +sub decode ($data) { my %items; my $pos = 0; diff --git a/lib/OpenHAP/Tasmota/Base.pm b/lib/OpenHAP/Tasmota/Base.pm index 6a17649..5df1244 100644 --- a/lib/OpenHAP/Tasmota/Base.pm +++ b/lib/OpenHAP/Tasmota/Base.pm @@ -31,7 +31,7 @@ use constant { AVAILABILITY_OFFLINE => 2, }; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new(%args); @@ -54,7 +54,7 @@ sub new( $class, %args ) # $self->subscribe_mqtt(): # Subscribe to all standard Tasmota topics. # Subclasses should call SUPER::subscribe_mqtt() first. -sub subscribe_mqtt($self) +sub subscribe_mqtt ($self) { my $topic = $self->{mqtt_topic}; @@ -66,35 +66,35 @@ sub subscribe_mqtt($self) # C1: Subscribe to LWT for device availability $self->{mqtt_client}->subscribe( $self->_build_topic( 'tele', 'LWT' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_lwt($payload); } ); # C2: Subscribe to tele/STATE for periodic state updates $self->{mqtt_client}->subscribe( $self->_build_topic( 'tele', 'STATE' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_state($payload); } ); # C3: Subscribe to stat/RESULT for command responses $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'RESULT' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_result($payload); } ); # Subscribe to tele/SENSOR for sensor data $self->{mqtt_client}->subscribe( $self->_build_topic( 'tele', 'SENSOR' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_sensor($payload); } ); # C1/H1: Subscribe to STATUS11 for full state reconciliation $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'STATUS11' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_status11($payload); } ); } @@ -102,7 +102,7 @@ sub subscribe_mqtt($self) # $self->query_initial_state(): # Query device for current state after connect or LWT Online. # Uses Status 11 for full state reconciliation (C1/H1). -sub query_initial_state($self) +sub query_initial_state ($self) { return unless $self->{mqtt_client}->is_connected(); @@ -116,21 +116,21 @@ sub query_initial_state($self) # $self->is_online(): # Check if device is online. -sub is_online($self) +sub is_online ($self) { return $self->{availability} == AVAILABILITY_ONLINE; } # $self->get_availability(): # Get device availability state. -sub get_availability($self) +sub get_availability ($self) { return $self->{availability}; } # $self->_handle_lwt($payload): # Handle LWT (Last Will and Testament) message (C1). -sub _handle_lwt( $self, $payload ) +sub _handle_lwt ( $self, $payload ) { my $prev = $self->{availability}; @@ -159,7 +159,7 @@ sub _handle_lwt( $self, $payload ) # $self->_handle_state($payload): # Handle periodic STATE message from tele/ topic (C2). -sub _handle_state( $self, $payload ) +sub _handle_state ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -174,7 +174,7 @@ sub _handle_state( $self, $payload ) # $self->_handle_result($payload): # Handle RESULT message from stat/ topic (C3). -sub _handle_result( $self, $payload ) +sub _handle_result ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -189,7 +189,7 @@ sub _handle_result( $self, $payload ) # $self->_handle_sensor($payload): # Handle SENSOR message from tele/ topic. -sub _handle_sensor( $self, $payload ) +sub _handle_sensor ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -210,7 +210,7 @@ sub _handle_sensor( $self, $payload ) # $self->_handle_status11($payload): # Handle STATUS11 response for state reconciliation (C1/H1). -sub _handle_status11( $self, $payload ) +sub _handle_status11 ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -239,7 +239,7 @@ sub _handle_status11( $self, $payload ) # $self->_process_state_data($data): # Process parsed STATE data. Override in subclasses. -sub _process_state_data( $self, $data ) +sub _process_state_data ( $self, $data ) { # Cache state data $self->{last_state} = { %{ $self->{last_state} }, %$data }; @@ -250,7 +250,7 @@ sub _process_state_data( $self, $data ) # $self->_process_result_data($data): # Process parsed RESULT data. Override in subclasses. -sub _process_result_data( $self, $data ) +sub _process_result_data ( $self, $data ) { # Default implementation: check for POWER state $self->_extract_power_state($data); @@ -258,14 +258,14 @@ sub _process_result_data( $self, $data ) # $self->_process_sensor_data($data): # Process parsed SENSOR data. Override in subclasses. -sub _process_sensor_data( $self, $data ) +sub _process_sensor_data ( $self, $data ) { # Default: no-op, subclasses should override } # $self->_extract_power_state($data): # Extract power state from JSON data, handling multi-relay (H1). -sub _extract_power_state( $self, $data ) +sub _extract_power_state ( $self, $data ) { my $power_key = $self->_get_power_key(); @@ -278,7 +278,7 @@ sub _extract_power_state( $self, $data ) # $self->_get_power_key(): # Get the power key name for this device. # Handles multi-relay (H1) and SetOption26 (M1) support. -sub _get_power_key($self) +sub _get_power_key ($self) { if ( $self->{relay_index} && $self->{relay_index} > 0 ) { return 'POWER' . $self->{relay_index}; @@ -294,7 +294,7 @@ sub _get_power_key($self) # $self->_get_power_topic(): # Get the power topic for commands (H1 multi-relay support). -sub _get_power_topic($self) +sub _get_power_topic ($self) { if ( $self->{relay_index} && $self->{relay_index} > 0 ) { return $self->_build_topic( 'cmnd', @@ -313,7 +313,7 @@ sub _get_power_topic($self) # Build a topic using the FullTopic pattern (H2). # $prefix: 'cmnd', 'stat', or 'tele' # $command: The command/topic suffix -sub _build_topic( $self, $prefix, $command ) +sub _build_topic ( $self, $prefix, $command ) { my $fulltopic = $self->{fulltopic}; my $topic = $self->{mqtt_topic}; @@ -330,21 +330,21 @@ sub _build_topic( $self, $prefix, $command ) # $self->_on_power_update($state): # Called when power state updates. Override in subclasses. -sub _on_power_update( $self, $state ) +sub _on_power_update ( $self, $state ) { # Default: no-op } # $self->_on_availability_changed($old, $new): # Called when device availability changes. Override in subclasses. -sub _on_availability_changed( $self, $old, $new ) +sub _on_availability_changed ( $self, $old, $new ) { # Default: no-op } # $self->convert_temperature($temp): # Convert temperature to Celsius if needed (H4). -sub convert_temperature( $self, $temp ) +sub convert_temperature ( $self, $temp ) { return $temp unless defined $temp; @@ -359,7 +359,7 @@ sub convert_temperature( $self, $temp ) # $self->set_power($state): # Set power state (0=OFF, 1=ON). -sub set_power( $self, $state ) +sub set_power ( $self, $state ) { my $command = $state ? 'ON' : 'OFF'; my $topic = $self->_get_power_topic(); @@ -371,7 +371,7 @@ sub set_power( $self, $state ) # $self->toggle_power(): # Toggle power state (L1). -sub toggle_power($self) +sub toggle_power ($self) { my $topic = $self->_get_power_topic(); @@ -381,7 +381,7 @@ sub toggle_power($self) # $self->blink($on): # Start or stop blinking (L2). -sub blink( $self, $on = 1 ) +sub blink ( $self, $on = 1 ) { my $topic = $self->_get_power_topic(); my $command = $on ? 'BLINK' : 'BLINKOFF'; @@ -393,7 +393,7 @@ sub blink( $self, $on = 1 ) # $self->query_status($type): # Query device status. # $type: 0 = all, 8 = sensors, 11 = full state, etc. -sub query_status( $self, $type = 11 ) +sub query_status ( $self, $type = 11 ) { $self->{mqtt_client} ->publish( $self->_build_topic( 'cmnd', 'Status' ), "$type" ); @@ -402,7 +402,7 @@ sub query_status( $self, $type = 11 ) # $self->force_telemetry(): # Force immediate telemetry update (L1). # Triggers STATE and SENSOR messages from the device. -sub force_telemetry($self) +sub force_telemetry ($self) { $OpenHAP::logger->debug( 'Forcing telemetry for %s', $self->{name} ); $self->{mqtt_client} diff --git a/lib/OpenHAP/Tasmota/Heater.pm b/lib/OpenHAP/Tasmota/Heater.pm index 4b9992a..6a2d0af 100644 --- a/lib/OpenHAP/Tasmota/Heater.pm +++ b/lib/OpenHAP/Tasmota/Heater.pm @@ -6,7 +6,7 @@ our @ISA = qw(OpenHAP::Tasmota::Base); use OpenHAP::Service; use OpenHAP::Characteristic; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new( aid => $args{aid}, @@ -45,7 +45,7 @@ sub new( $class, %args ) return $self; } -sub subscribe_mqtt($self) +sub subscribe_mqtt ($self) { # Call base class to set up standard subscriptions (C1, C2, C3) $self->SUPER::subscribe_mqtt(); @@ -59,7 +59,7 @@ sub subscribe_mqtt($self) # M2: Subscribe to plain-text POWER response (SetOption4 support) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', $self->_get_power_key() ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->{power_state} = ( $payload eq 'ON' ) ? 1 : 0; $OpenHAP::logger->debug( 'Heater %s power state: %s', $self->{name}, $payload ); @@ -68,7 +68,7 @@ sub subscribe_mqtt($self) } # Override _on_power_update to update our power state -sub _on_power_update( $self, $state ) +sub _on_power_update ( $self, $state ) { if ( $self->{power_state} != $state ) { $self->{power_state} = $state; diff --git a/lib/OpenHAP/Tasmota/Lightbulb.pm b/lib/OpenHAP/Tasmota/Lightbulb.pm index dc0d2f1..cca55a6 100644 --- a/lib/OpenHAP/Tasmota/Lightbulb.pm +++ b/lib/OpenHAP/Tasmota/Lightbulb.pm @@ -32,7 +32,7 @@ use constant { CAP_CT => 4, # Color temperature control }; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new( aid => $args{aid}, @@ -150,7 +150,7 @@ sub new( $class, %args ) return $self; } -sub subscribe_mqtt($self) +sub subscribe_mqtt ($self) { # Call base class to set up standard subscriptions (C1, C2, C3) $self->SUPER::subscribe_mqtt(); @@ -164,7 +164,7 @@ sub subscribe_mqtt($self) # M2: Subscribe to plain-text POWER response (SetOption4 support) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', $self->_get_power_key() ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->{power_state} = ( $payload eq 'ON' ) ? 1 : 0; $OpenHAP::logger->debug( 'Lightbulb %s power state: %s', $self->{name}, $payload ); @@ -175,7 +175,7 @@ sub subscribe_mqtt($self) if ( $self->{has_dimmer} ) { $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'DIMMER' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { if ( $payload =~ /^\d+$/ ) { $self->{brightness} = int($payload); $OpenHAP::logger->debug( @@ -190,7 +190,7 @@ sub subscribe_mqtt($self) if ( $self->{has_color} ) { $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'HSBCOLOR' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_parse_hsbcolor($payload); } ); } @@ -199,7 +199,7 @@ sub subscribe_mqtt($self) if ( $self->{has_ct} ) { $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'CT' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { if ( $payload =~ /^\d+$/ ) { my $ct = int($payload); $ct = 153 if $ct < 153; @@ -215,7 +215,7 @@ sub subscribe_mqtt($self) } # Override to process state data from periodic STATE messages -sub _process_state_data( $self, $data ) +sub _process_state_data ( $self, $data ) { $self->SUPER::_process_state_data($data); @@ -224,7 +224,7 @@ sub _process_state_data( $self, $data ) } # Override to process command results -sub _process_result_data( $self, $data ) +sub _process_result_data ( $self, $data ) { $self->SUPER::_process_result_data($data); @@ -233,7 +233,7 @@ sub _process_result_data( $self, $data ) } # Override _on_power_update to update our power state -sub _on_power_update( $self, $state ) +sub _on_power_update ( $self, $state ) { if ( $self->{power_state} != $state ) { $self->{power_state} = $state; @@ -245,7 +245,7 @@ sub _on_power_update( $self, $state ) # $self->_extract_light_state($data): # Extract light state from JSON data. -sub _extract_light_state( $self, $data ) +sub _extract_light_state ( $self, $data ) { my $changed = 0; @@ -290,7 +290,7 @@ sub _extract_light_state( $self, $data ) # $self->_set_brightness($value): # Set brightness level (0-100). -sub _set_brightness( $self, $value ) +sub _set_brightness ( $self, $value ) { $OpenHAP::logger->debug( 'Lightbulb %s brightness set to %d%%', $self->{name}, $value ); @@ -301,7 +301,7 @@ sub _set_brightness( $self, $value ) # $self->_set_hue($value): # Set hue (0-360). -sub _set_hue( $self, $value ) +sub _set_hue ( $self, $value ) { # Tasmota accepts 0-360 for hue (360 wraps to 0) $value = int($value) % 360; @@ -315,7 +315,7 @@ sub _set_hue( $self, $value ) # $self->_set_saturation($value): # Set saturation (0-100). -sub _set_saturation( $self, $value ) +sub _set_saturation ( $self, $value ) { $OpenHAP::logger->debug( 'Lightbulb %s saturation set to %d%%', $self->{name}, $value ); @@ -326,7 +326,7 @@ sub _set_saturation( $self, $value ) # $self->_set_ct($value): # Set color temperature in mireds (153-500). -sub _set_ct( $self, $value ) +sub _set_ct ( $self, $value ) { # Tasmota CT range is 153-500, clamp to that $value = 153 if $value < 153; @@ -341,7 +341,7 @@ sub _set_ct( $self, $value ) # $self->set_color($hue, $saturation, $brightness): # Set color using HSB values. -sub set_color( $self, $hue, $saturation, $brightness ) +sub set_color ( $self, $hue, $saturation, $brightness ) { $hue = int($hue) % 360; @@ -356,7 +356,7 @@ sub set_color( $self, $hue, $saturation, $brightness ) # $self->dimmer_step($direction): # Increase or decrease dimmer by step (L3). # $direction: '+' to increase, '-' to decrease -sub dimmer_step( $self, $direction = '+' ) +sub dimmer_step ( $self, $direction = '+' ) { $OpenHAP::logger->debug( 'Lightbulb %s dimmer step %s', $self->{name}, $direction ); @@ -367,7 +367,7 @@ sub dimmer_step( $self, $direction = '+' ) # $self->dimmer_min(): # Set dimmer to minimum (L3). -sub dimmer_min($self) +sub dimmer_min ($self) { $OpenHAP::logger->debug( 'Lightbulb %s dimmer to minimum', $self->{name} ); @@ -378,7 +378,7 @@ sub dimmer_min($self) # $self->dimmer_max(): # Set dimmer to maximum (L3). -sub dimmer_max($self) +sub dimmer_max ($self) { $OpenHAP::logger->debug( 'Lightbulb %s dimmer to maximum', $self->{name} ); @@ -389,7 +389,7 @@ sub dimmer_max($self) # $self->_parse_hsbcolor($value): # Parse HSBColor string "h,s,b" and update state. -sub _parse_hsbcolor( $self, $value ) +sub _parse_hsbcolor ( $self, $value ) { return unless $self->{has_color}; @@ -418,7 +418,7 @@ sub _parse_hsbcolor( $self, $value ) # $self->_parse_color($value): # Parse Color field (M3: SetOption17 support). # Handles both hex (FF5500) and decimal (255,85,0) formats. -sub _parse_color( $self, $value ) +sub _parse_color ( $self, $value ) { return unless $self->{has_color}; @@ -454,7 +454,7 @@ sub _parse_color( $self, $value ) # $self->_rgb_to_hsb($r, $g, $b): # Convert RGB (0-255) to HSB (h: 0-360, s: 0-100, b: 0-100). -sub _rgb_to_hsb( $self, $r, $g, $b ) +sub _rgb_to_hsb ( $self, $r, $g, $b ) { # Normalize to 0-1 my ( $rn, $gn, $bn ) = ( $r / 255, $g / 255, $b / 255 ); diff --git a/lib/OpenHAP/Tasmota/Sensor.pm b/lib/OpenHAP/Tasmota/Sensor.pm index 4f44f05..03fd678 100644 --- a/lib/OpenHAP/Tasmota/Sensor.pm +++ b/lib/OpenHAP/Tasmota/Sensor.pm @@ -12,7 +12,7 @@ use JSON::XS; use constant SENSOR_TYPES => qw(DS18B20 DHT11 DHT22 AM2301 BME280 BMP280 SHT3X SI7021); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new( aid => $args{aid}, @@ -79,7 +79,7 @@ sub new( $class, %args ) return $self; } -sub subscribe_mqtt($self) +sub subscribe_mqtt ($self) { # Call base class to set up standard subscriptions (C1, C2, C3) $self->SUPER::subscribe_mqtt(); @@ -93,26 +93,26 @@ sub subscribe_mqtt($self) # Subscribe to STATUS8 for sensor data (when actively queried) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'STATUS8' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_status8($payload); } ); # Subscribe to STATUS10 for sensor data (recommended per spec) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'STATUS10' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_status10($payload); } ); } # Override to process sensor data from SENSOR messages -sub _process_sensor_data( $self, $data ) +sub _process_sensor_data ( $self, $data ) { $self->_extract_sensor_values($data); } # Override to process sensor data from STATUS8 responses -sub _handle_status8( $self, $payload ) +sub _handle_status8 ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -137,7 +137,7 @@ sub _handle_status8( $self, $payload ) } # Override to handle STATUS10 responses (recommended sensor query) -sub _handle_status10( $self, $payload ) +sub _handle_status10 ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -160,7 +160,7 @@ sub _handle_status10( $self, $payload ) # $self->_extract_sensor_values($data): # Extract temperature and humidity from sensor data (H5). -sub _extract_sensor_values( $self, $data ) +sub _extract_sensor_values ( $self, $data ) { my ( $temp, $humidity, $sensor_id ) = $self->_find_sensor_values($data); @@ -192,7 +192,7 @@ sub _extract_sensor_values( $self, $data ) # $self->_find_sensor_values($data): # Find temperature, humidity, and sensor ID in sensor data (H5, L3). # Handles multiple sensor types and indexed sensors. -sub _find_sensor_values( $self, $data ) +sub _find_sensor_values ( $self, $data ) { my ( $temp, $humidity, $sensor_id ); diff --git a/lib/OpenHAP/Tasmota/Thermostat.pm b/lib/OpenHAP/Tasmota/Thermostat.pm index 5093104..66e84ce 100644 --- a/lib/OpenHAP/Tasmota/Thermostat.pm +++ b/lib/OpenHAP/Tasmota/Thermostat.pm @@ -12,7 +12,7 @@ use JSON::XS; use constant SENSOR_TYPES => qw(DS18B20 DHT11 DHT22 AM2301 BME280 BMP280 SHT3X SI7021); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = $class->SUPER::new( @@ -103,7 +103,7 @@ sub new( $class, %args ) return $self; } -sub subscribe_mqtt($self) +sub subscribe_mqtt ($self) { # Call base class to set up standard subscriptions (C1, C2, C3) $self->SUPER::subscribe_mqtt(); @@ -117,7 +117,7 @@ sub subscribe_mqtt($self) # M2: Subscribe to plain-text POWER response (SetOption4 support) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', $self->_get_power_key() ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { my $new_state = ( $payload eq 'ON' ) ? 1 : 0; if ( $self->{heating_state} != $new_state ) { $self->{heating_state} = $new_state; @@ -131,14 +131,14 @@ sub subscribe_mqtt($self) # Subscribe to STATUS8 for sensor data $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'STATUS8' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_status8($payload); } ); # Subscribe to STATUS10 for sensor data (recommended per spec) $self->{mqtt_client}->subscribe( $self->_build_topic( 'stat', 'STATUS10' ), - sub( $recv_topic, $payload ) { + sub ( $recv_topic, $payload ) { $self->_handle_status10($payload); } ); @@ -147,13 +147,13 @@ sub subscribe_mqtt($self) } # Override to process sensor data from SENSOR messages -sub _process_sensor_data( $self, $data ) +sub _process_sensor_data ( $self, $data ) { $self->_extract_temperature($data); } # Override to handle power state updates -sub _on_power_update( $self, $state ) +sub _on_power_update ( $self, $state ) { if ( $self->{heating_state} != $state ) { $self->{heating_state} = $state; @@ -164,7 +164,7 @@ sub _on_power_update( $self, $state ) } # Handle STATUS8 response -sub _handle_status8( $self, $payload ) +sub _handle_status8 ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -188,7 +188,7 @@ sub _handle_status8( $self, $payload ) } # Handle STATUS10 response (recommended sensor query) -sub _handle_status10( $self, $payload ) +sub _handle_status10 ( $self, $payload ) { eval { my $data = decode_json($payload); @@ -210,7 +210,7 @@ sub _handle_status10( $self, $payload ) # $self->_extract_temperature($data): # Extract temperature from sensor data (H4, H5). -sub _extract_temperature( $self, $data ) +sub _extract_temperature ( $self, $data ) { my $temp = $self->_find_temperature($data); @@ -230,7 +230,7 @@ sub _extract_temperature( $self, $data ) # $self->_find_temperature($data): # Find temperature value in sensor data (H5). -sub _find_temperature( $self, $data ) +sub _find_temperature ( $self, $data ) { # If sensor type is specified, look for that specific sensor if ( defined $self->{sensor_type} ) { @@ -267,7 +267,7 @@ sub _find_temperature( $self, $data ) return; } -sub _set_target_temp( $self, $temp ) +sub _set_target_temp ( $self, $temp ) { $OpenHAP::logger->debug( 'Thermostat %s target temperature set to %.1f°C', @@ -276,7 +276,7 @@ sub _set_target_temp( $self, $temp ) $self->_check_thermostat_logic(); } -sub _set_target_state( $self, $state ) +sub _set_target_state ( $self, $state ) { $OpenHAP::logger->debug( 'Thermostat %s target heating state set to %d', $self->{name}, $state ); @@ -284,7 +284,7 @@ sub _set_target_state( $self, $state ) $self->_check_thermostat_logic(); } -sub _check_thermostat_logic($self) +sub _check_thermostat_logic ($self) { # Simple bang-bang controller with 0.5°C hysteresis my $hysteresis = 0.5; diff --git a/lib/OpenHAP/Test/Integration.pm b/lib/OpenHAP/Test/Integration.pm index 0ac1868..ecb1407 100644 --- a/lib/OpenHAP/Test/Integration.pm +++ b/lib/OpenHAP/Test/Integration.pm @@ -41,7 +41,7 @@ use constant { PIDFILE => '/var/run/openhapd.pid', }; -sub new( $class, %options ) +sub new ( $class, %options ) { my $self = bless { config_file => $options{config_file} // DEFAULT_CONFIG, @@ -56,7 +56,7 @@ sub new( $class, %options ) return $self; } -sub setup($self) +sub setup ($self) { # Verify we're in integration test mode die "OPENHAP_INTEGRATION_TEST not set\n" @@ -77,7 +77,7 @@ sub setup($self) return 1; } -sub teardown($self) +sub teardown ($self) { # Close any open sockets for my $socket ( @{ $self->{sockets} } ) { @@ -93,7 +93,7 @@ sub teardown($self) return 1; } -sub http_request( $self, $method, $path, $body = undef, $headers = {} ) +sub http_request ( $self, $method, $path, $body = undef, $headers = {} ) { my $socket = IO::Socket::INET->new( PeerAddr => '127.0.0.1', @@ -139,7 +139,7 @@ sub http_request( $self, $method, $path, $body = undef, $headers = {} ) return $response; } -sub parse_http_response($response) +sub parse_http_response ($response) { return unless defined $response; @@ -159,17 +159,17 @@ sub parse_http_response($response) return ( $status, \%headers, $body // '' ); } -sub get_config_value( $self, $key ) +sub get_config_value ( $self, $key ) { return $self->{config}{$key}; } -sub get_device_topics($self) +sub get_device_topics ($self) { return @{ $self->{device_topics} // [] }; } -sub ensure_daemon_running($self) +sub ensure_daemon_running ($self) { # Check if already running return 1 if system('rcctl check openhapd >/dev/null 2>&1') == 0; @@ -182,7 +182,7 @@ sub ensure_daemon_running($self) return system('rcctl check openhapd >/dev/null 2>&1') == 0; } -sub ensure_daemon_stopped($self) +sub ensure_daemon_stopped ($self) { return 1 if system('rcctl check openhapd >/dev/null 2>&1') != 0; @@ -192,7 +192,7 @@ sub ensure_daemon_stopped($self) return system('rcctl check openhapd >/dev/null 2>&1') != 0; } -sub ensure_mqtt_running($self) +sub ensure_mqtt_running ($self) { # Check if already running return 1 if system('rcctl check mosquitto >/dev/null 2>&1') == 0; @@ -205,7 +205,7 @@ sub ensure_mqtt_running($self) return system('rcctl check mosquitto >/dev/null 2>&1') == 0; } -sub clear_logs($self) +sub clear_logs ($self) { return unless -w SYSLOG_FILE; @@ -215,7 +215,7 @@ sub clear_logs($self) return 1; } -sub get_log_lines( $self, $pattern = undef ) +sub get_log_lines ( $self, $pattern = undef ) { return () unless -r SYSLOG_FILE; @@ -235,7 +235,7 @@ sub get_log_lines( $self, $pattern = undef ) return @lines; } -sub get_mqtt($self) +sub get_mqtt ($self) { return $self->{mqtt} if defined $self->{mqtt}; @@ -255,7 +255,7 @@ sub get_mqtt($self) return $self->{mqtt}; } -sub _verify_system($self) +sub _verify_system ($self) { # Check required binaries return unless -x '/usr/sbin/rcctl'; @@ -275,7 +275,7 @@ sub _verify_system($self) return 1; } -sub _parse_config($self) +sub _parse_config ($self) { open my $fh, '<', $self->{config_file} or return; @@ -317,7 +317,7 @@ sub _parse_config($self) return 1; } -sub _count_log_lines($self) +sub _count_log_lines ($self) { return 0 unless -r SYSLOG_FILE; diff --git a/lib/OpenHVF/CLI.pm b/lib/OpenHVF/CLI.pm index 7c5f4dc..a9e93fe 100644 --- a/lib/OpenHVF/CLI.pm +++ b/lib/OpenHVF/CLI.pm @@ -62,7 +62,7 @@ my %commands = ( 'help' => \&cmd_help, ); -sub new( $class, %opts ) +sub new ( $class, %opts ) { my $mode = $opts{quiet} ? FuguLib::Log::MODE_QUIET : FuguLib::Log::MODE_STDERR; @@ -82,7 +82,7 @@ sub new( $class, %opts ) return $self; } -sub run( $class, @argv ) +sub run ( $class, @argv ) { my %opts; my $parser = Getopt::Long::Parser->new; @@ -143,7 +143,7 @@ sub run( $class, @argv ) return $commands{$command}->( $self, @argv ); } -sub _load_vm($self) +sub _load_vm ($self) { my $vm_config = $self->{config}->load_vm( $self->{vm_name} ); if ( !defined $vm_config ) { @@ -159,28 +159,28 @@ sub _load_vm($self) } # Idempotent: ensure VM is running -sub cmd_up( $self, @args ) +sub cmd_up ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; return $vm->up; } # Stop VM gracefully -sub cmd_down( $self, @args ) +sub cmd_down ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; return $vm->down; } # Stop VM and delete disk image -sub cmd_destroy( $self, @args ) +sub cmd_destroy ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; return $vm->destroy; } # Show VM status -sub cmd_status( $self, @args ) +sub cmd_status ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; my $status = $vm->status; @@ -195,14 +195,14 @@ sub cmd_status( $self, @args ) } # Start VM in background -sub cmd_start( $self, @args ) +sub cmd_start ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; return $vm->start; } # Stop VM -sub cmd_stop( $self, @args ) +sub cmd_stop ( $self, @args ) { my $force = 0; my $parser = Getopt::Long::Parser->new; @@ -215,7 +215,7 @@ sub cmd_stop( $self, @args ) } # SSH into VM or run command -sub cmd_ssh( $self, @args ) +sub cmd_ssh ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; @@ -238,7 +238,7 @@ sub cmd_ssh( $self, @args ) } # Show console connection info -sub cmd_console( $self, @args ) +sub cmd_console ( $self, @args ) { my $vm = $self->_load_vm or return EXIT_VM_NOT_FOUND; my $port = $vm->console_port; @@ -250,7 +250,7 @@ sub cmd_console( $self, @args ) } # Run expect script -sub cmd_expect( $self, @args ) +sub cmd_expect ( $self, @args ) { my $script = shift @args; if ( !defined $script ) { @@ -269,7 +269,7 @@ sub cmd_expect( $self, @args ) } # Wait for SSH to become available -sub cmd_wait( $self, @args ) +sub cmd_wait ( $self, @args ) { my $timeout = 120; my $parser = Getopt::Long::Parser->new; @@ -300,7 +300,7 @@ sub cmd_wait( $self, @args ) } # Image management -sub cmd_image( $self, @args ) +sub cmd_image ( $self, @args ) { my $action = shift @args; if ( !defined $action || $action !~ /^(download|list)$/ ) { @@ -342,7 +342,7 @@ sub cmd_image( $self, @args ) } # Disk management -sub cmd_disk( $self, @args ) +sub cmd_disk ( $self, @args ) { my $action = shift @args; if ( !defined $action || $action !~ /^(check|repair|info)$/ ) { @@ -412,7 +412,7 @@ sub cmd_disk( $self, @args ) } # Initialize project -sub cmd_init( $self, @args ) +sub cmd_init ( $self, @args ) { my $dir = shift @args // '.'; my $openhvf_dir = "$dir/.openhvf"; @@ -477,7 +477,7 @@ EOF return EXIT_SUCCESS; } -sub cmd_help( $, @ ) +sub cmd_help ( $, @ ) { print <<'EOF'; Usage: openhvf [--vm ] [options] @@ -515,7 +515,7 @@ EOF return EXIT_SUCCESS; } -sub _write_file( $path, $content ) +sub _write_file ( $path, $content ) { open my $fh, '>', $path or die "Cannot write $path: $!"; print $fh $content; diff --git a/lib/OpenHVF/Config.pm b/lib/OpenHVF/Config.pm index 55c9cd2..2f61cbb 100644 --- a/lib/OpenHVF/Config.pm +++ b/lib/OpenHVF/Config.pm @@ -33,7 +33,7 @@ use constant { PROJECT_CONFIG => '.openhvfrc', }; -sub new( $class, $project_root ) +sub new ( $class, $project_root ) { my $self = bless { project_root => $project_root, @@ -45,7 +45,7 @@ sub new( $class, $project_root ) } # Walk up directory tree looking for .openhvfrc -sub find_project_root($class) +sub find_project_root ($class) { my $dir = File::Spec->rel2abs('.'); @@ -61,7 +61,7 @@ sub find_project_root($class) return; } -sub _load_configs($self) +sub _load_configs ($self) { # Load global config from home directory my $home = $ENV{HOME} // '/root'; @@ -84,7 +84,7 @@ sub _load_configs($self) # vm "name" { ... } # vm name { ... } # -sub _parse_config( $self, $path ) +sub _parse_config ( $self, $path ) { my %config; @@ -144,7 +144,7 @@ sub _parse_config( $self, $path ) return \%config; } -sub load_vm( $self, $name ) +sub load_vm ( $self, $name ) { # First check for VM block in project config, then global config my $vm = $self->{project}{vm}{$name} // $self->{global}{vm}{$name}; @@ -171,7 +171,7 @@ sub load_vm( $self, $name ) return $vm; } -sub cache_dir($self) +sub cache_dir ($self) { my $dir = $self->{project}{cache_dir} // $self->{global}{cache_dir} // '~/.cache/openhvf'; @@ -182,7 +182,7 @@ sub cache_dir($self) return $dir; } -sub state_dir($self) +sub state_dir ($self) { my $dir = $self->{project}{state_dir} // "$self->{data_dir}/state"; @@ -194,18 +194,18 @@ sub state_dir($self) return $dir; } -sub default_vm($self) +sub default_vm ($self) { return $self->{project}{default_vm} // $self->{global}{default_vm} // 'default'; } -sub ssh_pubkey($self) +sub ssh_pubkey ($self) { return $self->{project}{ssh_pubkey} // $self->{global}{ssh_pubkey}; } -sub project_root($self) +sub project_root ($self) { return $self->{project_root}; } diff --git a/lib/OpenHVF/Disk.pm b/lib/OpenHVF/Disk.pm index cca97f1..ed54a3e 100644 --- a/lib/OpenHVF/Disk.pm +++ b/lib/OpenHVF/Disk.pm @@ -22,14 +22,14 @@ package OpenHVF::Disk; use File::Path qw(make_path); use File::Basename; -sub new( $class, $state_dir ) +sub new ( $class, $state_dir ) { my $self = bless { state_dir => $state_dir, }, $class; return $self; } -sub create( $self, $name, $size, $backing_image = undef ) +sub create ( $self, $name, $size, $backing_image = undef ) { my $path = $self->path($name); my $dir = dirname($path); @@ -60,17 +60,17 @@ sub create( $self, $name, $size, $backing_image = undef ) return $path; } -sub disk_exists( $self, $name ) +sub disk_exists ( $self, $name ) { return -f $self->path($name); } -sub path( $self, $name ) +sub path ( $self, $name ) { return "$self->{state_dir}/$name/disk.qcow2"; } -sub remove( $self, $name ) +sub remove ( $self, $name ) { my $path = $self->path($name); if ( -f $path ) { @@ -82,7 +82,7 @@ sub remove( $self, $name ) return 1; } -sub info( $self, $name ) +sub info ( $self, $name ) { my $path = $self->path($name); return if !-f $path; @@ -96,7 +96,7 @@ sub info( $self, $name ) # P5: Check disk image integrity # Returns hashref with 'status' ('ok' or 'corrupted') and 'output' -sub check( $self, $name ) +sub check ( $self, $name ) { my $path = $self->path($name); return if !-f $path; @@ -121,7 +121,7 @@ sub check( $self, $name ) # P5: Repair disk image # Returns true on success, false on failure -sub repair( $self, $name ) +sub repair ( $self, $name ) { my $path = $self->path($name); return 0 if !-f $path; diff --git a/lib/OpenHVF/Expect.pm b/lib/OpenHVF/Expect.pm index f723816..327ff7f 100644 --- a/lib/OpenHVF/Expect.pm +++ b/lib/OpenHVF/Expect.pm @@ -22,7 +22,7 @@ package OpenHVF::Expect; use File::Basename; use FindBin qw($RealBin); -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { host => $args{host} // 'localhost', @@ -33,7 +33,7 @@ sub new( $class, %args ) return $self; } -sub run_script( $self, $script, @args ) +sub run_script ( $self, $script, @args ) { if ( !-f $script ) { @@ -59,7 +59,7 @@ sub run_script( $self, $script, @args ) return $result == 0; } -sub _find_script( $self, $script_name ) +sub _find_script ( $self, $script_name ) { my @search_paths = ( "$RealBin/../share/openhvf/expect/$script_name", @@ -73,7 +73,7 @@ sub _find_script( $self, $script_name ) return; } -sub run_install( $self, $config ) +sub run_install ( $self, $config ) { my $script = $self->_find_script('install.exp') // "$RealBin/../share/openhvf/expect/install.exp"; @@ -96,7 +96,7 @@ sub run_install( $self, $config ) return $result == 0; } -sub install_ssh_key( $self, $password, $ssh_pubkey ) +sub install_ssh_key ( $self, $password, $ssh_pubkey ) { if ( !defined $ssh_pubkey || $ssh_pubkey eq '' ) { warn "No SSH public key provided\n"; @@ -121,7 +121,7 @@ sub install_ssh_key( $self, $password, $ssh_pubkey ) return $result == 0; } -sub halt_system( $self, $password ) +sub halt_system ( $self, $password ) { my $script = $self->_find_script('command.exp'); if ( !defined $script ) { diff --git a/lib/OpenHVF/Image.pm b/lib/OpenHVF/Image.pm index f8001dc..246541f 100644 --- a/lib/OpenHVF/Image.pm +++ b/lib/OpenHVF/Image.pm @@ -31,7 +31,7 @@ use constant { ARCH => 'arm64', }; -sub new( $class, $cache_dir, $proxy = undef ) +sub new ( $class, $cache_dir, $proxy = undef ) { # Expand ~ in path $cache_dir =~ s/^~/$ENV{HOME}/; @@ -47,7 +47,7 @@ sub new( $class, $cache_dir, $proxy = undef ) # $self->path($version): # Return path to cached miniroot image for given version # Returns undef if not cached -sub path( $self, $version ) +sub path ( $self, $version ) { my $path = $self->_image_path($version); return -f $path ? $path : undef; @@ -56,7 +56,7 @@ sub path( $self, $version ) # $self->ensure($version): # Ensure image is available, downloading if necessary # Returns path on success, undef on failure -sub ensure( $self, $version ) +sub ensure ( $self, $version ) { # Check if already cached my $path = $self->path($version); @@ -69,7 +69,7 @@ sub ensure( $self, $version ) # $self->download($version): # Download miniroot image for version via proxy cache # Returns path on success, undef on failure -sub download( $self, $version ) +sub download ( $self, $version ) { if ( !defined $self->{proxy} ) { warn "No proxy available for download\n"; @@ -126,7 +126,7 @@ sub download( $self, $version ) # $self->url($version): # Return the CDN URL for a miniroot image -sub url( $self, $version ) +sub url ( $self, $version ) { my $filename = $self->_image_filename($version); return @@ -140,7 +140,7 @@ sub url( $self, $version ) # $self->list: # List all cached miniroot images # Returns arrayref of { version, filename, path } -sub list($self) +sub list ($self) { my @images; my $base_path = $self->_proxy_cache_path; @@ -180,7 +180,7 @@ sub list($self) # $self->_image_filename($version): # Generate miniroot filename for version (e.g., "miniroot78.img") -sub _image_filename( $self, $version ) +sub _image_filename ( $self, $version ) { ( my $ver = $version ) =~ s/\.//g; return "miniroot$ver.img"; @@ -188,7 +188,7 @@ sub _image_filename( $self, $version ) # $self->_image_path($version): # Return expected cache path for miniroot image -sub _image_path( $self, $version ) +sub _image_path ( $self, $version ) { my $filename = $self->_image_filename($version); return $self->_proxy_cache_path . "/$version/" . ARCH . "/$filename"; @@ -196,7 +196,7 @@ sub _image_path( $self, $version ) # $self->_proxy_cache_path: # Return base path for proxy-cached OpenBSD files -sub _proxy_cache_path($self) +sub _proxy_cache_path ($self) { return "$self->{cache_dir}/proxy/" . CDN_HOST . "/pub/OpenBSD"; } diff --git a/lib/OpenHVF/Output.pm b/lib/OpenHVF/Output.pm index b35e61e..14862ff 100644 --- a/lib/OpenHVF/Output.pm +++ b/lib/OpenHVF/Output.pm @@ -21,7 +21,7 @@ package OpenHVF::Output; use FuguLib::Log; -sub new( $class, $quiet = 0 ) +sub new ( $class, $quiet = 0 ) { my $mode = $quiet ? FuguLib::Log::MODE_QUIET : FuguLib::Log::MODE_STDERR; @@ -34,32 +34,32 @@ sub new( $class, $quiet = 0 ) bless { log => $log }, $class; } -sub info( $self, $message ) +sub info ( $self, $message ) { $self->{log}->info($message); } -sub error( $self, $message ) +sub error ( $self, $message ) { $self->{log}->error($message); } -sub warn( $self, $message ) +sub warn ( $self, $message ) { $self->{log}->warning($message); } -sub success( $self, $message ) +sub success ( $self, $message ) { $self->{log}->info($message); } -sub data( $self, $hashref ) +sub data ( $self, $hashref ) { $self->_format_data($hashref); } -sub _format_data( $self, $data, $indent = 0 ) +sub _format_data ( $self, $data, $indent = 0 ) { my $prefix = ' ' x $indent; my @lines; @@ -105,7 +105,7 @@ sub _format_data( $self, $data, $indent = 0 ) } } -sub _format_data_lines( $self, $data, $indent = 0 ) +sub _format_data_lines ( $self, $data, $indent = 0 ) { my $prefix = ' ' x $indent; my @lines; @@ -140,7 +140,7 @@ sub _format_data_lines( $self, $data, $indent = 0 ) return @lines; } -sub pid( $self, $name, $pid ) +sub pid ( $self, $name, $pid ) { $self->{log}->info("Started $name (PID: $pid)"); } diff --git a/lib/OpenHVF/Proxy.pm b/lib/OpenHVF/Proxy.pm index 4a5ac69..5414b23 100644 --- a/lib/OpenHVF/Proxy.pm +++ b/lib/OpenHVF/Proxy.pm @@ -32,7 +32,7 @@ use OpenHVF::Proxy::MetaCache; # $class->run_child($port, $cache_dir): # Entry point for spawned child process # Sets up cache and runs the proxy server -sub run_child( $class, $port, $cache_dir ) +sub run_child ( $class, $port, $cache_dir ) { my $log = FuguLib::Log->new( mode => 'stderr', level => 'debug' ); my $cache = OpenHVF::Proxy::Cache->new($cache_dir); @@ -64,7 +64,7 @@ use constant { HOST_GATEWAY => '10.0.2.2', # QEMU user-mode networking gateway }; -sub new( $class, $state, $cache_dir ) +sub new ( $class, $state, $cache_dir ) { my $self = bless { state => $state, @@ -79,7 +79,7 @@ sub new( $class, $state, $cache_dir ) # $self->start: # Start the proxy server # Returns port number on success, undef on failure -sub start($self) +sub start ($self) { # Check if already running if ( $self->is_running ) { @@ -104,13 +104,13 @@ sub start($self) stdout => $log, stderr => $log, check_alive => 1, - on_success => sub($pid) { + on_success => sub ($pid) { # Record state in callback $self->{state}->set_proxy_pid($pid); $self->{state}->set_proxy_port($port); }, - on_error => sub($err) { + on_error => sub ($err) { warn "Proxy failed to start: $err\n"; }, ); @@ -129,7 +129,7 @@ sub start($self) # $self->stop: # Stop the proxy server gracefully -sub stop($self) +sub stop ($self) { my $pid = $self->{state}->get_proxy_pid; return 1 if !defined $pid; @@ -160,21 +160,21 @@ sub stop($self) # $self->is_running: # Check if proxy is running -sub is_running($self) +sub is_running ($self) { return $self->{state}->is_proxy_running; } # $self->port: # Get current proxy port -sub port($self) +sub port ($self) { return $self->{state}->get_proxy_port; } # $self->guest_url: # Get proxy URL for use from VM guest (via QEMU gateway) -sub guest_url($self) +sub guest_url ($self) { my $port = $self->port; return if !defined $port; @@ -184,7 +184,7 @@ sub guest_url($self) # $self->host_url: # Get proxy URL for use from host (localhost) -sub host_url($self) +sub host_url ($self) { my $port = $self->port; return if !defined $port; @@ -194,7 +194,7 @@ sub host_url($self) # $self->wait_ready($timeout): # Wait for proxy to accept connections -sub wait_ready( $self, $timeout = CONNECT_TIMEOUT ) +sub wait_ready ( $self, $timeout = CONNECT_TIMEOUT ) { my $port = $self->{state}->get_proxy_port; return 0 if !defined $port; @@ -219,12 +219,12 @@ sub wait_ready( $self, $timeout = CONNECT_TIMEOUT ) # $self->cache: # Get the cache object -sub cache($self) +sub cache ($self) { return $self->{cache}; } -sub _find_available_port($self) +sub _find_available_port ($self) { for my $port ( PORT_RANGE_START .. PORT_RANGE_END ) { my $sock = IO::Socket::INET->new( @@ -244,7 +244,7 @@ sub _find_available_port($self) # $self->_run_proxy($port): # Run the proxy server (called in child process) -sub _run_proxy( $self, $port ) +sub _run_proxy ( $self, $port ) { require HTTP::Daemon; require LWP::UserAgent; @@ -307,7 +307,7 @@ sub _run_proxy( $self, $port ) $daemon->close; } -sub _handle_client( $self, $client ) +sub _handle_client ( $self, $client ) { while ( my $request = $client->get_request ) { @@ -351,7 +351,7 @@ sub _handle_client( $self, $client ) } } -sub _process_request( $self, $request ) +sub _process_request ( $self, $request ) { require HTTP::Response; require LWP::UserAgent; @@ -411,7 +411,7 @@ sub _process_request( $self, $request ) return $response; } -sub _forward_request( $self, $request ) +sub _forward_request ( $self, $request ) { require LWP::UserAgent; @@ -436,7 +436,7 @@ sub _forward_request( $self, $request ) } # Old _serve_cached for non-streaming fallback -sub _serve_cached( $self, $path, $request ) +sub _serve_cached ( $self, $path, $request ) { require HTTP::Response; @@ -475,7 +475,7 @@ sub _serve_cached( $self, $path, $request ) } # New optimized streaming implementation -sub _serve_cached_streaming( $self, $socket, $meta, $request ) +sub _serve_cached_streaming ( $self, $socket, $meta, $request ) { # Optimize socket for large transfers # Disable Nagle's algorithm for immediate sends @@ -539,7 +539,7 @@ sub _serve_cached_streaming( $self, $socket, $meta, $request ) } # Send HTTP response headers to socket -sub _send_response_headers( $self, $socket, $code, $message, $headers ) +sub _send_response_headers ( $self, $socket, $code, $message, $headers ) { my $response = "HTTP/1.1 $code $message\r\n"; for my $name ( keys %$headers ) { @@ -559,7 +559,7 @@ sub _send_response_headers( $self, $socket, $code, $message, $headers ) } # Stream file to socket using large buffers (256KB) -sub _stream_file_to_socket( $self, $socket, $path, $size ) +sub _stream_file_to_socket ( $self, $socket, $path, $size ) { open my $fh, '<', $path or do { $self->{log}->error( 'Cannot open file for streaming: %s: %s', diff --git a/lib/OpenHVF/Proxy/Cache.pm b/lib/OpenHVF/Proxy/Cache.pm index d8c2421..1e43b92 100644 --- a/lib/OpenHVF/Proxy/Cache.pm +++ b/lib/OpenHVF/Proxy/Cache.pm @@ -34,7 +34,7 @@ my @CACHEABLE_PATTERNS = ( qr{/pub/OpenBSD/\d+\.\d+/\w+/.*\.txt$}, # Text files (index, etc) ); -sub new( $class, $cache_dir ) +sub new ( $class, $cache_dir ) { my $self = bless { cache_dir => $cache_dir, }, $class; @@ -43,7 +43,7 @@ sub new( $class, $cache_dir ) return $self; } -sub _ensure_dir($self) +sub _ensure_dir ($self) { my $proxy_dir = "$self->{cache_dir}/proxy"; if ( !-d $proxy_dir ) { @@ -54,7 +54,7 @@ sub _ensure_dir($self) # $self->cache_path($url): # Convert URL to filesystem cache path # Returns undef if URL cannot be converted safely -sub cache_path( $self, $url ) +sub cache_path ( $self, $url ) { require URI; my $uri = URI->new($url); @@ -74,7 +74,7 @@ sub cache_path( $self, $url ) # $self->is_cacheable($url, $status_code): # Determine if a URL response should be cached -sub is_cacheable( $self, $url, $status_code = 200 ) +sub is_cacheable ( $self, $url, $status_code = 200 ) { # Only cache successful responses return 0 if $status_code != 200; @@ -90,7 +90,7 @@ sub is_cacheable( $self, $url, $status_code = 200 ) # $self->lookup($url): # Check if URL is in cache # Returns cache file path if found, undef otherwise -sub lookup( $self, $url ) +sub lookup ( $self, $url ) { my $path = $self->cache_path($url); return if !defined $path; @@ -101,7 +101,7 @@ sub lookup( $self, $url ) # $self->store($url, $content): # Store content in cache # Returns cache file path on success, undef on failure -sub store( $self, $url, $content ) +sub store ( $self, $url, $content ) { my $path = $self->cache_path($url); return if !defined $path; @@ -138,7 +138,7 @@ sub store( $self, $url, $content ) # $self->store_from_file($url, $source_path): # Store content from a file into cache # Returns cache file path on success, undef on failure -sub store_from_file( $self, $url, $source_path ) +sub store_from_file ( $self, $url, $source_path ) { my $path = $self->cache_path($url); return if !defined $path; @@ -164,7 +164,7 @@ sub store_from_file( $self, $url, $source_path ) # $self->size: # Calculate total cache size in bytes -sub size($self) +sub size ($self) { my $proxy_dir = "$self->{cache_dir}/proxy"; return 0 if !-d $proxy_dir; @@ -172,7 +172,7 @@ sub size($self) my $total = 0; $self->_walk_dir( $proxy_dir, - sub($file) { + sub ($file) { $total += -s $file if -f $file; } ); @@ -181,7 +181,7 @@ sub size($self) # $self->clear: # Remove all cached files -sub clear($self) +sub clear ($self) { my $proxy_dir = "$self->{cache_dir}/proxy"; return 1 if !-d $proxy_dir; @@ -196,7 +196,7 @@ sub clear($self) # $self->list: # List all cached files # Returns arrayref of {url => $url, path => $path, size => $size} -sub list($self) +sub list ($self) { my $proxy_dir = "$self->{cache_dir}/proxy"; my @files; @@ -205,7 +205,7 @@ sub list($self) $self->_walk_dir( $proxy_dir, - sub($path) { + sub ($path) { return if !-f $path; # Reconstruct URL from path @@ -227,7 +227,7 @@ sub list($self) return \@files; } -sub _walk_dir( $self, $dir, $callback ) +sub _walk_dir ( $self, $dir, $callback ) { opendir my $dh, $dir or return; diff --git a/lib/OpenHVF/Proxy/MetaCache.pm b/lib/OpenHVF/Proxy/MetaCache.pm index 7147798..d8bb7f8 100644 --- a/lib/OpenHVF/Proxy/MetaCache.pm +++ b/lib/OpenHVF/Proxy/MetaCache.pm @@ -23,7 +23,7 @@ package OpenHVF::Proxy::MetaCache; # Caches file metadata (path, size, mtime, content_type, etag) # to avoid repeated stat() calls and content-type detection -sub new($class) +sub new ($class) { bless { entries => {}, # URL -> {path, size, mtime, content_type, etag} @@ -34,7 +34,7 @@ sub new($class) # Lookup cached metadata for a URL # Returns metadata hashref if found and still valid, undef otherwise # Validates that file still exists and hasn't been modified -sub lookup( $self, $url ) +sub lookup ( $self, $url ) { my $entry = $self->{entries}{$url}; return unless $entry; @@ -53,7 +53,7 @@ sub lookup( $self, $url ) # Store metadata for a URL # Stats the file and caches all relevant metadata # Returns metadata hashref on success, undef on failure -sub store( $self, $url, $path ) +sub store ( $self, $url, $path ) { my @stat = stat $path; return unless @stat; @@ -74,14 +74,14 @@ sub store( $self, $url, $path ) # $self->remove($url): # Remove a URL from the cache -sub remove( $self, $url ) +sub remove ( $self, $url ) { delete $self->{entries}{$url}; } # $self->clear: # Clear all cached metadata -sub clear($self) +sub clear ($self) { $self->{entries} = {}; } @@ -89,7 +89,7 @@ sub clear($self) # $self->warm($cache): # Pre-warm the metadata cache by scanning all cached files # Takes an OpenHVF::Proxy::Cache object -sub warm( $self, $cache ) +sub warm ( $self, $cache ) { my $cache_dir = $cache->{cache_dir}; my $proxy_dir = "$cache_dir/proxy"; @@ -105,7 +105,7 @@ sub warm( $self, $cache ) # $self->_guess_content_type($path): # Guess content type from file extension -sub _guess_content_type( $self, $path ) +sub _guess_content_type ( $self, $path ) { return 'application/x-gzip' if $path =~ /\.tgz$/; return 'application/gzip' if $path =~ /\.gz$/; @@ -120,7 +120,7 @@ sub _guess_content_type( $self, $path ) # $self->_generate_etag($mtime, $size): # Generate an ETag from file modification time and size # Format: "mtime-size" in hex -sub _generate_etag( $self, $mtime, $size ) +sub _generate_etag ( $self, $mtime, $size ) { return sprintf( '"%x-%x"', $mtime, $size ); } @@ -128,7 +128,7 @@ sub _generate_etag( $self, $mtime, $size ) # $self->_walk_cache_dir($dir, $cache_dir, $callback): # Recursively walk cache directory and invoke callback for each file # Reconstructs URLs from filesystem paths -sub _walk_cache_dir( $self, $dir, $cache_dir, $callback ) +sub _walk_cache_dir ( $self, $dir, $cache_dir, $callback ) { opendir my $dh, $dir or return; my @entries = readdir $dh; @@ -153,7 +153,7 @@ sub _walk_cache_dir( $self, $dir, $cache_dir, $callback ) # $self->_path_to_url($path, $cache_dir): # Convert cache filesystem path back to URL -sub _path_to_url( $self, $path, $cache_dir ) +sub _path_to_url ( $self, $path, $cache_dir ) { my $proxy_dir = "$cache_dir/proxy"; return unless $path =~ s{^\Q$proxy_dir\E/}{}; diff --git a/lib/OpenHVF/QGA.pm b/lib/OpenHVF/QGA.pm index b2aa052..5b92f8b 100644 --- a/lib/OpenHVF/QGA.pm +++ b/lib/OpenHVF/QGA.pm @@ -32,7 +32,7 @@ use constant { READ_TIMEOUT => 30, }; -sub new( $class, $socket_path ) +sub new ( $class, $socket_path ) { bless { socket_path => $socket_path, @@ -42,9 +42,9 @@ sub new( $class, $socket_path ) }, $class; } -sub socket_path($self) { $self->{socket_path} } +sub socket_path ($self) { $self->{socket_path} } -sub open_connection($self) +sub open_connection ($self) { return 1 if $self->{connected}; @@ -64,7 +64,7 @@ sub open_connection($self) return 1; } -sub disconnect($self) +sub disconnect ($self) { if ( $self->{sock} ) { close $self->{sock}; @@ -74,14 +74,14 @@ sub disconnect($self) return $self; } -sub is_available($self) +sub is_available ($self) { return -S $self->{socket_path}; } # $self->run_command($command, $arguments): # Execute a QGA command and return the result -sub run_command( $self, $command, $arguments = undef ) +sub run_command ( $self, $command, $arguments = undef ) { return if !$self->{sock}; @@ -96,7 +96,7 @@ sub run_command( $self, $command, $arguments = undef ) return $self->_read_response; } -sub _read_response($self) +sub _read_response ($self) { my $sock = $self->{sock}; return if !$sock; @@ -125,14 +125,14 @@ sub _read_response($self) # $self->sync: # Sync guest filesystems (flush all buffers to disk) # Returns true on success -sub sync($self) +sub sync ($self) { # guest-sync is used to synchronize the protocol, not filesystems # We use guest-exec to run sync command for actual filesystem sync return $self->_exec_sync_command; } -sub _exec_sync_command($self) +sub _exec_sync_command ($self) { # Execute 'sync' command in guest my $result = $self->run_command( @@ -166,7 +166,7 @@ sub _exec_sync_command($self) # $self->freeze_filesystems: # Freeze all mounted filesystems (quiesce for snapshot) # Returns number of frozen filesystems on success, undef on failure -sub freeze_filesystems($self) +sub freeze_filesystems ($self) { my $result = $self->run_command('guest-fsfreeze-freeze'); return if !defined $result || exists $result->{error}; @@ -176,7 +176,7 @@ sub freeze_filesystems($self) # $self->thaw_filesystems: # Thaw all frozen filesystems # Returns number of thawed filesystems on success, undef on failure -sub thaw_filesystems($self) +sub thaw_filesystems ($self) { my $result = $self->run_command('guest-fsfreeze-thaw'); return if !defined $result || exists $result->{error}; @@ -186,7 +186,7 @@ sub thaw_filesystems($self) # $self->fsfreeze_status: # Get current filesystem freeze status # Returns 'thawed', 'frozen', or undef on error -sub fsfreeze_status($self) +sub fsfreeze_status ($self) { my $result = $self->run_command('guest-fsfreeze-status'); return if !defined $result || exists $result->{error}; @@ -195,7 +195,7 @@ sub fsfreeze_status($self) # $self->ping: # Check if guest agent is responsive -sub ping($self) +sub ping ($self) { my $result = $self->run_command('guest-ping'); return defined $result && !exists $result->{error}; @@ -204,7 +204,7 @@ sub ping($self) # $self->shutdown($mode): # Request guest to shutdown # $mode: 'powerdown' (default), 'halt', or 'reboot' -sub shutdown( $self, $mode = 'powerdown' ) +sub shutdown ( $self, $mode = 'powerdown' ) { my $result = $self->run_command( 'guest-shutdown', { mode => $mode } ); diff --git a/lib/OpenHVF/QMP.pm b/lib/OpenHVF/QMP.pm index 2e24086..b1b0805 100644 --- a/lib/OpenHVF/QMP.pm +++ b/lib/OpenHVF/QMP.pm @@ -32,7 +32,7 @@ use constant { READ_TIMEOUT => 10, }; -sub new( $class, $socket_path ) +sub new ( $class, $socket_path ) { bless { socket_path => $socket_path, @@ -41,7 +41,7 @@ sub new( $class, $socket_path ) }, $class; } -sub open_connection($self) +sub open_connection ($self) { return 1 if $self->{connected}; @@ -73,7 +73,7 @@ sub open_connection($self) return 1; } -sub disconnect($self) +sub disconnect ($self) { if ( $self->{sock} ) { close $self->{sock}; @@ -85,7 +85,7 @@ sub disconnect($self) # $self->run_command($command, $arguments): # Execute a QMP command and return the result -sub run_command( $self, $command, $arguments = undef ) +sub run_command ( $self, $command, $arguments = undef ) { return if !$self->{sock}; @@ -100,7 +100,7 @@ sub run_command( $self, $command, $arguments = undef ) return $self->_read_response; } -sub _read_response($self) +sub _read_response ($self) { my $sock = $self->{sock}; return if !$sock; @@ -129,7 +129,7 @@ sub _read_response($self) # $self->query_status: # Query VM running status # Returns hashref with 'running' and 'status' keys -sub query_status($self) +sub query_status ($self) { my $result = $self->run_command('query-status'); return if !defined $result || exists $result->{error}; @@ -138,7 +138,7 @@ sub query_status($self) # $self->is_running: # Check if VM is currently running -sub is_running($self) +sub is_running ($self) { my $status = $self->query_status; return 0 if !defined $status; @@ -147,7 +147,7 @@ sub is_running($self) # $self->powerdown: # Request graceful guest shutdown via ACPI -sub powerdown($self) +sub powerdown ($self) { my $result = $self->run_command('system_powerdown'); return defined $result && !exists $result->{error}; @@ -155,7 +155,7 @@ sub powerdown($self) # $self->quit: # Immediately terminate QEMU process -sub quit($self) +sub quit ($self) { my $result = $self->run_command('quit'); $self->disconnect; diff --git a/lib/OpenHVF/SSH.pm b/lib/OpenHVF/SSH.pm index d2ec4d9..afcf5ee 100644 --- a/lib/OpenHVF/SSH.pm +++ b/lib/OpenHVF/SSH.pm @@ -30,7 +30,7 @@ use constant { BUFFER_SIZE => 32768, }; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { host => $args{host} // 'localhost', @@ -46,7 +46,7 @@ sub new( $class, %args ) # $self->_connect: # Establish SSH connection and authenticate using SSH agent # or password fallback. Returns Net::SSH2 object on success. -sub _connect($self) +sub _connect ($self) { my $ssh2 = Net::SSH2->new; $ssh2->timeout( $self->{timeout} * 1000 ); # milliseconds @@ -74,7 +74,7 @@ sub _connect($self) return; } -sub wait_available( $self, $timeout = 120, $sig = undef ) +sub wait_available ( $self, $timeout = 120, $sig = undef ) { my $start = time; @@ -96,7 +96,7 @@ sub wait_available( $self, $timeout = 120, $sig = undef ) return 0; } -sub run_command( $self, $command ) +sub run_command ( $self, $command ) { my $ssh2 = $self->_connect; if ( !defined $ssh2 ) { @@ -152,7 +152,7 @@ sub run_command( $self, $command ) }; } -sub interactive($self) +sub interactive ($self) { # For interactive sessions, fall back to system ssh command # Net::SSH2 doesn't provide proper TTY handling for interactive use @@ -174,7 +174,7 @@ sub interactive($self) # $self->write_file($remote_path, $content, $mode): # Write content directly to a remote file via SFTP -sub write_file( $self, $remote_path, $content, $mode = 0644 ) +sub write_file ( $self, $remote_path, $content, $mode = 0644 ) { my $ssh2 = $self->_connect; if ( !defined $ssh2 ) { @@ -204,7 +204,7 @@ sub write_file( $self, $remote_path, $content, $mode = 0644 ) # $self->make_remote_dir($remote_path, $mode): # Create a remote directory -sub make_remote_dir( $self, $remote_path, $mode = 0755 ) +sub make_remote_dir ( $self, $remote_path, $mode = 0755 ) { my $ssh2 = $self->_connect; if ( !defined $ssh2 ) { @@ -223,7 +223,7 @@ sub make_remote_dir( $self, $remote_path, $mode = 0755 ) return $result ? EXIT_SUCCESS : EXIT_ERROR; } -sub is_available($self) +sub is_available ($self) { my $ssh2 = $self->_connect; if ( !defined $ssh2 ) { diff --git a/lib/OpenHVF/State.pm b/lib/OpenHVF/State.pm index 06f7e7d..71b4053 100644 --- a/lib/OpenHVF/State.pm +++ b/lib/OpenHVF/State.pm @@ -24,7 +24,7 @@ use JSON::XS; use constant { MAX_VM_NAME_LENGTH => 255, }; -sub new( $class, $state_dir, $vm_name, %opts ) +sub new ( $class, $state_dir, $vm_name, %opts ) { # Validate VM name length if ( length($vm_name) > MAX_VM_NAME_LENGTH ) { @@ -60,7 +60,7 @@ sub new( $class, $state_dir, $vm_name, %opts ) return $self; } -sub _ensure_dir($self) +sub _ensure_dir ($self) { my $dir = $self->{vm_state_dir}; @@ -90,7 +90,7 @@ sub _ensure_dir($self) return 1; } -sub load($self) +sub load ($self) { if ( -f $self->{status_file} ) { open my $fh, '<', $self->{status_file} or return; @@ -111,7 +111,7 @@ sub load($self) return $self; } -sub save($self) +sub save ($self) { open my $fh, '>', $self->{status_file} or do { warn "Cannot write $self->{status_file}: $!\n"; @@ -125,7 +125,7 @@ sub save($self) } # VM PID management -sub set_vm_pid( $self, $pid ) +sub set_vm_pid ( $self, $pid ) { open my $fh, '>', $self->{vm_pid_file} or do { warn "Cannot write $self->{vm_pid_file}: $!"; @@ -137,7 +137,7 @@ sub set_vm_pid( $self, $pid ) return $self; } -sub get_vm_pid($self) +sub get_vm_pid ($self) { open my $fh, '<', $self->{vm_pid_file} or return; my $pid = <$fh>; @@ -148,13 +148,13 @@ sub get_vm_pid($self) return; } -sub clear_vm_pid($self) +sub clear_vm_pid ($self) { unlink $self->{vm_pid_file}; return $self; } -sub is_vm_running($self) +sub is_vm_running ($self) { my $pid = $self->get_vm_pid; return 0 if !defined $pid; @@ -164,7 +164,7 @@ sub is_vm_running($self) } # Proxy PID management -sub set_proxy_pid( $self, $pid ) +sub set_proxy_pid ( $self, $pid ) { open my $fh, '>', $self->{proxy_pid_file} or do { warn "Cannot write $self->{proxy_pid_file}: $!"; @@ -176,7 +176,7 @@ sub set_proxy_pid( $self, $pid ) return $self; } -sub get_proxy_pid($self) +sub get_proxy_pid ($self) { open my $fh, '<', $self->{proxy_pid_file} or return; my $pid = <$fh>; @@ -187,13 +187,13 @@ sub get_proxy_pid($self) return; } -sub clear_proxy_pid($self) +sub clear_proxy_pid ($self) { unlink $self->{proxy_pid_file}; return $self; } -sub is_proxy_running($self) +sub is_proxy_running ($self) { my $pid = $self->get_proxy_pid; return 0 if !defined $pid; @@ -203,19 +203,19 @@ sub is_proxy_running($self) } # Proxy port management -sub set_proxy_port( $self, $port ) +sub set_proxy_port ( $self, $port ) { $self->{data}{proxy_port} = $port; $self->save; return $self; } -sub get_proxy_port($self) +sub get_proxy_port ($self) { return $self->{data}{proxy_port}; } -sub clear_proxy_port($self) +sub clear_proxy_port ($self) { delete $self->{data}{proxy_port}; $self->save; @@ -226,7 +226,7 @@ sub clear_proxy_port($self) # $self->ensure_proxy($cache_dir): # Start proxy if not running, return Proxy object # Returns undef if proxy cannot be started -sub ensure_proxy( $self, $cache_dir ) +sub ensure_proxy ( $self, $cache_dir ) { require OpenHVF::Proxy; @@ -246,7 +246,7 @@ sub ensure_proxy( $self, $cache_dir ) # $self->get_proxy($cache_dir): # Get Proxy object if running, undef if not -sub get_proxy( $self, $cache_dir ) +sub get_proxy ( $self, $cache_dir ) { require OpenHVF::Proxy; @@ -256,7 +256,7 @@ sub get_proxy( $self, $cache_dir ) # $self->stop_proxy($cache_dir): # Stop proxy if running -sub stop_proxy( $self, $cache_dir ) +sub stop_proxy ( $self, $cache_dir ) { require OpenHVF::Proxy; @@ -269,23 +269,23 @@ sub stop_proxy( $self, $cache_dir ) } # Disk state -sub disk_path($self) +sub disk_path ($self) { return $self->{disk_path}; } -sub disk_exists($self) +sub disk_exists ($self) { return -f $self->{disk_path}; } # Installation state -sub is_installed($self) +sub is_installed ($self) { return $self->{data}{installed} ? 1 : 0; } -sub mark_installed($self) +sub mark_installed ($self) { $self->{data}{installed} = 1; $self->{data}{installed_at} = time; @@ -294,14 +294,14 @@ sub mark_installed($self) } # Root password management (stored securely in state for initial setup) -sub set_root_password( $self, $password ) +sub set_root_password ( $self, $password ) { $self->{data}{root_password} = $password; $self->save; return $self; } -sub get_root_password($self) +sub get_root_password ($self) { return $self->{data}{root_password}; } @@ -310,12 +310,12 @@ sub get_root_password($self) # Tracks both whether an SSH key has been installed and which specific key # was installed. This allows the system to detect when the configured SSH # key has changed and automatically reinstall the new key. -sub is_ssh_key_installed($self) +sub is_ssh_key_installed ($self) { return $self->{data}{ssh_key_installed} ? 1 : 0; } -sub mark_ssh_key_installed( $self, $ssh_pubkey = undef ) +sub mark_ssh_key_installed ( $self, $ssh_pubkey = undef ) { $self->{data}{ssh_key_installed} = 1; $self->{data}{ssh_key_installed_at} = time; @@ -325,12 +325,12 @@ sub mark_ssh_key_installed( $self, $ssh_pubkey = undef ) return $self; } -sub get_installed_ssh_pubkey($self) +sub get_installed_ssh_pubkey ($self) { return $self->{data}{installed_ssh_pubkey}; } -sub ssh_key_matches( $self, $ssh_pubkey ) +sub ssh_key_matches ( $self, $ssh_pubkey ) { return 0 if !$self->is_ssh_key_installed; my $installed = $self->get_installed_ssh_pubkey; @@ -338,12 +338,12 @@ sub ssh_key_matches( $self, $ssh_pubkey ) return $installed eq $ssh_pubkey; } -sub vm_state_dir($self) +sub vm_state_dir ($self) { return $self->{vm_state_dir}; } -sub data($self) +sub data ($self) { return $self->{data}; } @@ -351,7 +351,7 @@ sub data($self) # Shutdown state tracking # Tracks whether VM was shutdown cleanly to detect filesystem corruption risk -sub mark_clean_shutdown($self) +sub mark_clean_shutdown ($self) { $self->{data}{shutdown_clean} = 1; $self->{data}{shutdown_at} = time; @@ -360,7 +360,7 @@ sub mark_clean_shutdown($self) return $self; } -sub mark_unclean_shutdown($self) +sub mark_unclean_shutdown ($self) { $self->{data}{shutdown_clean} = 0; $self->{data}{shutdown_at} = time; @@ -369,7 +369,7 @@ sub mark_unclean_shutdown($self) return $self; } -sub mark_running($self) +sub mark_running ($self) { $self->{data}{running} = 1; $self->{data}{started_at} = time; @@ -378,7 +378,7 @@ sub mark_running($self) return $self; } -sub was_unclean_shutdown($self) +sub was_unclean_shutdown ($self) { # If explicitly marked as unclean if ( exists $self->{data}{shutdown_clean} @@ -395,7 +395,7 @@ sub was_unclean_shutdown($self) return 0; } -sub clear_shutdown_state($self) +sub clear_shutdown_state ($self) { delete $self->{data}{shutdown_clean}; delete $self->{data}{running}; diff --git a/lib/OpenHVF/Util.pm b/lib/OpenHVF/Util.pm index 890bece..eb5d858 100644 --- a/lib/OpenHVF/Util.pm +++ b/lib/OpenHVF/Util.pm @@ -29,7 +29,7 @@ use constant { # $class->generate_random_bytes($length): # Generate $length bytes of cryptographically secure random data # from /dev/urandom -sub generate_random_bytes( $, $length ) +sub generate_random_bytes ( $, $length ) { open my $fh, '<', URANDOM_PATH or die "Cannot open " . URANDOM_PATH . ": $!"; @@ -42,7 +42,7 @@ sub generate_random_bytes( $, $length ) # $class->generate_password($length): # Generate a strong random password of specified length using # base64-encoded random bytes (URL-safe variant without padding) -sub generate_password( $class, $length = PASSWORD_LENGTH ) +sub generate_password ( $class, $length = PASSWORD_LENGTH ) { # Generate more bytes than needed since base64 expands my $raw_bytes = diff --git a/lib/OpenHVF/VM.pm b/lib/OpenHVF/VM.pm index edabe65..ad04fd6 100644 --- a/lib/OpenHVF/VM.pm +++ b/lib/OpenHVF/VM.pm @@ -49,7 +49,7 @@ use constant { CPU_COUNT => 2, }; -sub new( $class, %args ) +sub new ( $class, %args ) { my $self = bless { config => $args{config}, @@ -61,7 +61,7 @@ sub new( $class, %args ) } # Idempotent: ensure VM is running -sub up($self) +sub up ($self) { my $config = $self->{config}; my $state = $self->{state}; @@ -240,7 +240,7 @@ sub up($self) return EXIT_SUCCESS; } -sub down($self) +sub down ($self) { my $state = $self->{state}; my $log = $self->{log}; @@ -280,7 +280,7 @@ sub down($self) return EXIT_SUCCESS; } -sub destroy($self) +sub destroy ($self) { my $state = $self->{state}; my $log = $self->{log}; @@ -320,7 +320,7 @@ sub destroy($self) return EXIT_SUCCESS; } -sub start($self) +sub start ($self) { my $state = $self->{state}; my $log = $self->{log}; @@ -346,7 +346,7 @@ sub start($self) return EXIT_SUCCESS; } -sub stop( $self, $force = 0 ) +sub stop ( $self, $force = 0 ) { my $state = $self->{state}; my $log = $self->{log}; @@ -387,7 +387,7 @@ sub stop( $self, $force = 0 ) return EXIT_SUCCESS; } -sub status($self) +sub status ($self) { my $state = $self->{state}; my $config = $self->{config}; @@ -417,28 +417,28 @@ sub status($self) }; } -sub is_running($self) +sub is_running ($self) { return $self->_is_running; } -sub pid($self) +sub pid ($self) { return $self->{state}->get_vm_pid; } -sub ssh_port($self) +sub ssh_port ($self) { return $self->{config}{ssh_port}; } -sub console_port($self) +sub console_port ($self) { return $self->{config}{console_port}; } # Wait operations -sub wait_ssh( $self, $timeout = 120, $sig = undef ) +sub wait_ssh ( $self, $timeout = 120, $sig = undef ) { my $config = $self->{config}; @@ -455,7 +455,7 @@ sub wait_ssh( $self, $timeout = 120, $sig = undef ) # $self->_wait_ssh_password($password, $timeout): # Wait for SSH to become available using password authentication # Used during initial installation before SSH key is installed -sub _wait_ssh_password( $self, $password, $timeout = 120 ) +sub _wait_ssh_password ( $self, $password, $timeout = 120 ) { my $config = $self->{config}; @@ -473,7 +473,7 @@ sub _wait_ssh_password( $self, $password, $timeout = 120 ) # Check if SSH key needs to be installed or updated. # Returns true if no key is installed, or if the configured key # differs from the installed key. -sub _needs_ssh_key_update($self) +sub _needs_ssh_key_update ($self) { my $config = $self->{config}; my $state = $self->{state}; @@ -499,7 +499,7 @@ sub _needs_ssh_key_update($self) # Uses the stored root password to authenticate. # Called when recovering from a failed first boot or when the # configured SSH key has changed. -sub _complete_ssh_setup($self) +sub _complete_ssh_setup ($self) { my $state = $self->{state}; my $config = $self->{config}; @@ -535,7 +535,7 @@ sub _complete_ssh_setup($self) # $self->_install_ssh_key($password): # Install the SSH public key from config into authorized_keys # Uses password authentication since key is not yet installed -sub _install_ssh_key( $self, $password ) +sub _install_ssh_key ( $self, $password ) { my $config = $self->{config}; my $state = $self->{state}; @@ -585,7 +585,7 @@ sub _install_ssh_key( $self, $password ) # 1. SSH sync + ACPI powerdown (sync via SSH, powerdown via QMP) # 2. QGA guest-shutdown (if available) # 3. Direct ACPI powerdown -sub _graceful_shutdown($self) +sub _graceful_shutdown ($self) { my $config = $self->{config}; my $log = $self->{log}; @@ -644,12 +644,12 @@ sub _graceful_shutdown($self) } # QGA methods -sub _qga_socket_path($self) +sub _qga_socket_path ($self) { return $self->{state}{vm_state_dir} . '/qga.sock'; } -sub _qga_connect($self) +sub _qga_connect ($self) { my $qga = OpenHVF::QGA->new( $self->_qga_socket_path ); return if !$qga->is_available; @@ -657,18 +657,18 @@ sub _qga_connect($self) } # QMP methods -sub _qmp_socket_path($self) +sub _qmp_socket_path ($self) { return $self->{state}{vm_state_dir} . '/qmp.sock'; } -sub _qmp_connect($self) +sub _qmp_connect ($self) { my $qmp = OpenHVF::QMP->new( $self->_qmp_socket_path ); return $qmp->open_connection ? $qmp : undef; } -sub _qmp_powerdown($self) +sub _qmp_powerdown ($self) { my $qmp = $self->_qmp_connect or return 0; my $result = $qmp->powerdown; @@ -676,13 +676,13 @@ sub _qmp_powerdown($self) return $result; } -sub _qmp_quit($self) +sub _qmp_quit ($self) { my $qmp = $self->_qmp_connect or return 0; return $qmp->quit; } -sub _is_running($self) +sub _is_running ($self) { my $pid = $self->{state}->get_vm_pid; return 0 if !defined $pid; @@ -702,7 +702,7 @@ sub _is_running($self) return 1; } -sub _wait_exit( $self, $timeout ) +sub _wait_exit ( $self, $timeout ) { my $start = time; while ( time - $start < $timeout ) { @@ -714,7 +714,7 @@ sub _wait_exit( $self, $timeout ) } # QEMU startup -sub _start_qemu( $self, $boot_image = undef ) +sub _start_qemu ( $self, $boot_image = undef ) { my $config = $self->{config}; my $state = $self->{state}; @@ -811,7 +811,7 @@ sub _start_qemu( $self, $boot_image = undef ) return; } -sub _find_efi_firmware($self) +sub _find_efi_firmware ($self) { my @paths = ( '/opt/homebrew/share/qemu/edk2-aarch64-code.fd', @@ -830,7 +830,7 @@ sub _find_efi_firmware($self) return; } -sub _cache_dir($self) +sub _cache_dir ($self) { my $home = $ENV{HOME} // '/root'; return "$home/.cache/openhvf"; diff --git a/scripts/deps.sh b/scripts/deps.sh index 33175e7..65daac1 100755 --- a/scripts/deps.sh +++ b/scripts/deps.sh @@ -78,7 +78,26 @@ if [ -n "$CPAN_MODULES" ]; then curl -L https://cpanmin.us | perl - App::cpanminus fi - cpanm --notest $CPAN_MODULES + # Determine installation target + # If PERL5LIB is set, use --local-lib to install to that location + # This allows running with sudo while still installing to user's local lib + CPANM_OPTS="--notest" + if [ -n "$PERL5LIB" ]; then + # Extract the first directory from PERL5LIB (may contain multiple paths) + LOCAL_LIB=$(echo "$PERL5LIB" | cut -d: -f1) + # Derive the local::lib root from PERL5LIB path + # PERL5LIB typically contains paths like /path/to/local/lib/perl5 + # We need to pass /path/to/local to cpanm --local-lib + case "$LOCAL_LIB" in + */local/lib/perl5*) + LOCAL_ROOT=$(echo "$LOCAL_LIB" | sed 's|/lib/perl5.*||') + echo "Installing to local directory: $LOCAL_ROOT" + CPANM_OPTS="$CPANM_OPTS --local-lib=$LOCAL_ROOT" + ;; + esac + fi + + cpanm $CPANM_OPTS $CPAN_MODULES fi echo "Dependencies for $ENV installed successfully" diff --git a/t/openhvf/vm.t b/t/openhvf/vm.t index 6c7e2eb..ed42960 100644 --- a/t/openhvf/vm.t +++ b/t/openhvf/vm.t @@ -6,6 +6,12 @@ use Test::More; use FindBin qw($RealBin); use lib "$RealBin/../../lib"; +# Check if module can be loaded (may fail if Net::SSH2 not available) +BEGIN { + eval { require OpenHVF::VM; 1 } + or plan skip_all => 'OpenHVF::VM dependencies not available'; +} + use_ok('OpenHVF::VM'); # Memory and CPU constants