jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
317 Commits
1 Branch
1 Tag
202 MiB
 
 
 
 
 
 
Tree: 43f325808c
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '43f325808c'
${ noResults }
punkshell/src/modules/punk/netbox/man-999999.0a1.0.tm

601 lines
22 KiB
Raw Blame History

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application punk::netbox::man 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_punk::netbox::man 0 999999.0a1.0]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::netbox::man]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of punk::netbox::man
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::netbox::man
#[list_begin itemized]
package require Tcl 8.6-
package require punk::netbox
package require uri
package require rest
#*** !doctools
#[item] [package {Tcl 8.6}]
#[item] [package {punk::netbox}]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#tcl::namespace::eval punk::netbox::man::class {
#*** !doctools
#[subsection {Namespace punk::netbox::man::class}]
#[para] class definitions
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} {
#*** !doctools
#[list_begin enumerated]
# oo::class create interface_sample1 {
# #*** !doctools
# #[enum] CLASS [class interface_sample1]
# #[list_begin definitions]
# method test {arg1} {
# #*** !doctools
# #[call class::interface_sample1 [method test] [arg arg1]]
# #[para] test method
# puts "test: $arg1"
# }
# #*** !doctools
# #[list_end] [comment {-- end definitions interface_sample1}]
# }
#*** !doctools
#[list_end] [comment {--- end class enumeration ---}]
#}
#}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man {
namespace export {[a-z]*}
variable PUNKARGS
#review + ?
proc uri_part_decode {uripart} {
set specialMap {"[" "%5B" "]" "%5D" + " "}
set seqRE {%([0-9a-fA-F]{2})}
set replacement {[format "%c" [scan "\1" "%2x"]]}
set modstr [regsub -all $seqRE [string map $specialMap $uripart] $replacement]
return [encoding convertfrom utf-8 [subst -nobackslash -novariable $modstr]]
}
proc uri_get_querystring_as_keyval_list {uri} {
set parts [uri::split $uri]
set query ?[dict get $parts query]
set raw_plist [rest::parameters $query] ;#not a dict - can have repeated params (important for <name>_FILTER methods)
return [lmap v $raw_plist {uri_part_decode $v}]
}
}
tcl::namespace::eval punk::netbox::man::prefixes {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection {Namespace punk::netbox::man}]
#[para] Core API functions for punk::netbox::man
#[list_begin definitions]
namespace export {[a-z]*}
namespace ensemble create
variable PUNKARGS
lappend PUNKARGS [::list\
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes list"}} ::punk::netbox::ipam::prefixes_list]\
{-RETURN -default table -choices {table tableobject list}}\
{@values -min 0 -max 0}\
]
#caution: must use ::list to avoid loop
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes list"]
set token tclread ;#todo
set next ""
set requests_allowed 1000 ;#review
set resultlist [::list]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
while {$next ne "null"} {
if {$next ni [::list "" null]} {
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next]
#don't use any dict write operations on plist/nextopts - can destroy dup keys
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry
if {$p_offset != -1} {
lappend nextopts -offset [lindex $plist $p_offset+1]
}
set p_limit [lsearch -stride 2 $plist limit]
if {$p_limit != -1} {
lappend nextopts -limit [lindex $plist $p_limit+1]
}
}
puts "-->next:$next nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::ipam::prefixes_list $token {*}$nextopts -RETURN dict {*}$vals]
set next [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id prefix family vrf tenant children status vlan description _depth}]
foreach pfx $resultlist {
if {[dict exists $pfx tenant id]} {
set tenant "[dict get $pfx tenant id]: [dict get $pfx tenant slug]"
} else {
set tenant [dict get $pfx tenant] ;#probably null
}
if {[dict exists $pfx vlan id]} {
set vlan "[dict get $pfx vlan id]: [dict get $pfx vlan display]"
} else {
set vlan [dict get $pfx vlan] ;#probably null
}
set r [::list\
[dict get $pfx id]\
[dict get $pfx display]\
[dict get $pfx family label]\
[dict get $pfx vrf id]\
$tenant\
[dict get $pfx children]\
[dict get $pfx status value]\
$vlan\
[dict get $pfx description]\
[dict get $pfx _depth]\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
}
return $resultlist
#return [showdict $resultd]
}
#lappend PUNKARGS [::list\
# [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\
# {-RETURN -default table -choices {table tableobject list}}
# ]
lappend PUNKARGS [::list\
[punk::args::resolved_def\
-antiglobs {apicontextid @leaders -offset}\
-override {\
@id {-id "::punk::netbox::man::prefixes available-ips_list"}\
-limit {-default 254 -help "Maximum number of entries to return"}\
-RETURN {-default table -choices {table tableobject list linelist}}\
@values {-min 1 -max 1}\
}\
::punk::netbox::ipam::prefixes_available-ips_list\
]\
]
proc available-ips_list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes available-ips_list"]
set token tclread ;#todo
set next ""
set requests_allowed 1000 ;#review
set resultlist [::list]
set opts [dict get $argd opts]
set valuedict [dict get $argd values]
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
#No paging available at endpoint ipam/prefixes/available-ips - but we can still use limit (but offset doesn't seem to work
set resultlist [punk::netbox::ipam::prefixes_available-ips_list $token {*}$nextopts -RETURN list {*}$vals]
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {address family vrf}]
foreach ip $resultlist {
set r [::list\
[dict get $ip address]\
[dict get $ip family]\
"[dict get $ip vrf id]: [dict get $ip vrf name]"\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
jsondump {
#todo
package require huddle::json
#pretty-print via huddle (inefficient review)
set h [huddle::json::json2huddle parse $result]
return [huddle::jsondump $h]
}
default {
return $resultlist
}
}
#return [showdict $resultd]
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::netbox::man ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man::ip-addresses {
namespace export {[a-z]*}
namespace ensemble create
variable PUNKARGS
lappend PUNKARGS [::list\
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::ip-addresses list"}} ::punk::netbox::ipam::ip-addresses_list]\
{-RETURN -default table -choices {table tableobject list}}\
{@values -min 0 -max 0}\
]
#caution: must use ::list to avoid loop
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::ip-addresses list"]
set token tclread ;#todo
set next ""
set requests_allowed 1000 ;#review
set resultlist [::list]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
while {$next ne "null"} {
if {$next ni [::list "" null]} {
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next]
#don't use any dict write operations on plist/nextopts - can destroy dup keys
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry
if {$p_offset != -1} {
lappend nextopts -offset [lindex $plist $p_offset+1]
}
set p_limit [lsearch -stride 2 $plist limit]
if {$p_limit != -1} {
lappend nextopts -limit [lindex $plist $p_limit+1]
}
}
puts "-->next:$next nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::ipam::ip-addresses_list $token {*}$nextopts -RETURN dict {*}$vals]
set next [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id address family vrf_id tenant status assigned_object_type deviceinfo dns_name description}]
foreach ip $resultlist {
if {[dict exists $ip tenant id]} {
set tenant "[dict get $ip tenant id]: [dict get $ip tenant slug]"
} else {
set tenant [dict get $ip tenant] ;#probably null
}
switch -- [dict get $ip assigned_object_type] {
dcim.interface {
set device_id [dict get $ip assigned_object device id]
set device_display [dict get $ip assigned_object device display]
set deviceinfo "$device_id: $device_display"
}
virtualization.vminterface {
set deviceinfo "vm"
}
default {
set deviceinfo -
}
}
set r [::list\
[dict get $ip id]\
[dict get $ip address]\
[dict get $ip family label]\
[dict get $ip vrf id]\
$tenant\
[dict get $ip status value]\
[dict get $ip assigned_object_type]\
$deviceinfo\
[dict get $ip dns_name]\
[dict get $ip description]\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
}
return $resultlist
#return [showdict $resultd]
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace punk::netbox::man::lib}]
#[para] Secondary functions that are part of the API
#[list_begin definitions]
#proc utility1 {p1 args} {
# #*** !doctools
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
# #[para]Description of utility1
# return 1
#}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::netbox::man::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
#tcl::namespace::eval punk::netbox::man::system {
#*** !doctools
#[subsection {Namespace punk::netbox::man::system}]
#[para] Internal functions that are not part of the API
#}
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval punk::netbox::man {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)punk::netbox::man"
@package -name "punk::netbox::man" -help\
"Package
Description"
}]
namespace eval argdoc {
#namespace for custom argument documentation
proc package_name {} {
return punk::netbox::man
}
proc about_topics {} {
#info commands results are returned in an arbitrary order (like array keys)
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
#Adjust this function or 'default_topics' if a different order is required
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package punk::netbox::man
A management wrapper over the punk::netbox
REST API.
} \n]
}
proc get_topic_License {} {
return "<unspecified>"
}
proc get_topic_Version {} {
return "$::punk::netbox::man::version"
}
proc get_topic_Contributors {} {
set authors {<julian@precisium.com.au> Julian Noble}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
proc get_topic_custom-topic {} {
punk::args::lib::tstr -return string {
todo - next available ip-address from prefix
}
}
# -------------------------------------------------------------
}
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::punk::netbox::man::about"
dict set overrides @cmd -name "punk::netbox::man::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About punk::netbox::man
}] \n]
dict set overrides topic -choices [list {*}[punk::netbox::man::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [punk::netbox::man::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::punk::netbox::man::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::punk::netbox::man::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
# variable PUNKARGS
# variable PUNKARGS_aliases
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES\
::punk::netbox::man\
::punk::netbox::man::prefixes\
::punk::netbox::man::ip-addresses
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::netbox::man [tcl::namespace::eval punk::netbox::man {
variable pkg punk::netbox::man
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]