Skip to content

A
acs-developer-support
Commit e1492d01 authored by Frank Bergmann's avatar Frank Bergmann
Browse files
Options

Initial Import

parents
Pipeline #58 failed with stages
      Expand all Hide whitespace changes
      Inline Side-by-side
      Showing with 1164 additions and 0 deletions
      acs-developer-support.info 0 → 100644
      View file @ e1492d01
      <?xml version="1.0"?>
      <!-- Generated by the OpenACS Package Manager -->
      <package key="acs-developer-support" url="http://openacs.org/repository/apm/packages/acs-developer-support/" type="apm_service">
      <package-name>Developer Support</package-name>
      <pretty-plural>Developer Support</pretty-plural>
      <initial-install-p>f</initial-install-p>
      <singleton-p>t</singleton-p>
      <auto-mount>ds</auto-mount>
      <version name="5.0d5" url="http://openacs.org/repository/download/apm/acs-developer-support-5.0d5.apm">
      <owner url="mailto:lars@pinds.com">Lars Pind</owner>
      <summary>Profiling for requests including database timing information.</summary>
      <release-date>2003-11-10</release-date>
      <vendor url="http://openacs.org">OpenACS</vendor>
      <description format="text/html">Developer support stores timing and other logged information for requests
      to support debugging and tuning and supports user switching and a Tcl Sell to invoke arbitrary tcl code on the server.
      </description>
      <provides url="acs-developer-support" version="5.0d5"/>
      <requires url="acs-kernel" version="4.6.2"/>
      <callbacks>
      </callbacks>
      <parameters>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="DatabaseEnabledP" default="0" description="Remember information about every database request?" section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="DataLifetime" default="900" description="Number of seconds to keep connection data" section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="DataSweepInterval" default="900" description="Number of seconds between sweeping for old data" section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="EnabledIPs" default="*" description="remember information for which client hosts?" section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="EnabledOnStartupP" default="1" description="Remember information about connections, for developers' benefit?" section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="PackageWatchList" description="A space separated list of keys for packages that you are developing on and that will have full watches (automatic reloading of tcl libraries and xql files) activated on every server startup.
      " section_name="developer-support"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="ShowCommentsInlineP" default="0" description="Controls whether comments are shown inline in the ds_link." section_name="developer-support"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="UserSwitchingEnabledP" default="0" description="Will present a widget on every page that allows you to switch user" section_name="developer-support"/>
      </parameters>
      </version>
      </package>
      lib/footer.adp 0 → 100644
      View file @ e1492d01
      <if @show_p@ true>
      <if @comments:rowcount@ gt 0>
      <div class="developer-support-footer">
      <multiple name="comments">
      <b>Comment:</b> <pre style="display: inline;">@comments.text@</pre><br />
      </multiple>
      </div>
      </if>
      <if @user_switching_p@ true>
      <form action="@set_user_url@">
      @export_vars;noquote@
      <div class="developer-support-footer">
      Real user: @real_user_name@ (@real_user_email@) [user_id #@real_user_id@]<br />
      <if @real_user_id@ ne @fake_user_id@>
      Faked user: @fake_user_name@ <if @fake_user_email@ not nil>(@fake_user_email@)</if> [user_id #@fake_user_id@] <a href="@unfake_url@">(Unfake)</a><br />
      </if>
      <else>
      Faked user: <i>Not faking.</i><br />
      </else>
      Change faked user: <if @search_p@ eq "0"><select name="user_id">
      <multiple name="users">
      <option value="@users.user_id@" <if @users.selected_p@>selected</if>>@users.name@ <if @users.email@ not nil>(@users.email@)</if></option>
      </multiple>
      </select></if><else><input type="text" name="keyword"><input type="hidden" name="target" value="@target@"></else>
      <input type="submit" value="Go">
      </div>
      </form>
      </if>
      <if @profiling:rowcount@ gt 0>
      <div class="developer-support-footer">
      <h3>Profiling Information</h3>
      <table>
      <tr>
      <th>Tag</th>
      <th># Iterations</th>
      <th>Total time </th>
      <th>Avg. time per iteration</th>
      </tr>
      <multiple name="profiling">
      <tr>
      <td>@profiling.tag@</td>
      <td align="right">@profiling.num_iterations@</td>
      <td align="right">@profiling.total_ms@ ms</td>
      <td align="right">@profiling.ms_per_iteration@ ms</td>
      </tr>
      </multiple>
      </table>
      </div>
      </if>
      </if>
      lib/footer.tcl 0 → 100644
      View file @ e1492d01
      set show_p [ds_show_p]
      # TODO: Go through request-processor to see what other information should be exposed to developer-support
      # TODO: Always show comments inline by default?
      if { $show_p } {
      set ds_url [ds_support_url]
      #set comments_p [ds_comments_p]
      # LARS: Always have comments turned on
      set comments_p 1
      multirow create comments text
      if { $comments_p } {
      foreach comment [ds_get_comments] {
      multirow append comments $comment
      }
      }
      set user_switching_p [ds_user_switching_enabled_p]
      if { $user_switching_p } {
      set fake_user_id [ad_get_user_id]
      set real_user_id [ds_get_real_user_id]
      if { $fake_user_id == 0 } {
      set selected " selected"
      set you_are "<small>You are currently <strong>not logged in</strong></small><br />"
      set you_are_really "<small>You are really <strong>not logged in</strong></small><br />"
      } else {
      set selected {}
      }
      # Default values
      set fake_user_name {Unregistered Visitor}
      set real_user_name {Unregistered Visitor}
      set fake_user_email {}
      set real_user_email {}
      set set_user_url "${ds_url}set-user"
      set export_vars [export_vars -form { { return_url [ad_return_url] } }]
      set unfake_url [export_vars -base $set_user_url { { user_id $real_user_id } { return_url [ad_return_url] } }]
      #Decide what to do based on how many users there are.
      set n_users [util_memoize {db_string select_n_users "select count(user_id) from users" -default "unknown"} 300]
      if { $n_users > 100 } {
      set search_p 1
      set size_restriction "and u.user_id in (:real_user_id, :fake_user_id)"
      #Remap the set_user_url to the users search page
      set target $set_user_url
      set set_user_url /acs-admin/users/search
      } else {
      set search_p 0
      set size_restriction ""
      }
      db_multirow -unclobber -extend { selected_p } users select_users "
      select u.user_id,
      pe.first_names || ' ' || pe.last_name as name,
      pa.email
      from users u,
      persons pe,
      parties pa
      where pa.party_id = u.user_id
      and pe.person_id = u.user_id
      $size_restriction
      order by lower(pe.first_names), lower(pe.last_name)
      " {
      if { $fake_user_id == $user_id } {
      set selected_p 1
      set fake_user_name $name
      set fake_user_email $email
      } else {
      set selected_p 0
      }
      if { $real_user_id == $user_id } {
      set real_user_name $name
      set real_user_email $email
      }
      }
      }
      # Profiling information
      global ds_profile__total_ms ds_profile__iterations
      multirow create profiling tag num_iterations total_ms ms_per_iteration
      if { [info exists ds_profile__total_ms] } {
      foreach tag [lsort [array names ds_profile__total_ms]] {
      multirow append profiling $tag [set ds_profile__iterations($tag)] [lc_numeric [set ds_profile__total_ms($tag)]] \
      [ad_decode [set ds_profile__iterations($tag)] 0 {} \
      [lc_numeric [expr [set ds_profile__total_ms($tag)]/[set ds_profile__iterations($tag)]]]]
      }
      }
      }
      lib/toolbar.adp 0 → 100644
      View file @ e1492d01
      <if @show_p@ true>
      <table cellspacing="0" cellpadding="0" width="100%" border="0" id="developer-toolbar">
      <tr>
      <td>
      <a href="@ds_url@">Developer Support</a>
      </td>
      <td class="action-list">
      <ul>
      <li><a href="@user_switching_toggle_url@" class="@user_switching_on@" title="User switching">USR</a></li>
      <li><a href="@db_toggle_url@" class="@db_on@" title="Database statistics">DB</a></li>
      <li><a href="@translator_toggle_url@" class="@translator_on@" title="Translator mode">TRN</a></li>
      </ul>
      </td>
      <td align="center" class="action-list">
      <ul>
      <li><a href="@request_info_url@" title="View request information">@request_info_label@</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="@oacs_shell_url@" title="Execute commands and see the result">Shell</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/acs-admin/apm/" title="Modify/reload packages">APM</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/admin/site-map/" title="Manage your package instances">Site Map</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/acs-admin/apm/?reload_links_p=1" title="Scan for changed library files">Changed</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="@flush_url@" title="Flush entire util_memoize cache">Flush</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="@auto_test_url@" title="Automated Testing Home">Test</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/acs-admin/users/" title="Add/edit/become users">Users</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/acs-lang/admin/" title="Add/edit message keys">I18n</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/doc/" title="View system documentation">Docs</a>
      <span style="color: #cccccc;">|</span></li>
      <li><a href="/api-doc/" title="View/search OpenACS Tcl API documentation">API doc</a></li>
      </ul>
      </td>
      <form action="/api-doc/proc-search">
      <input type="hidden" name="search_type" value="All+matches">
      <input type="hidden" name="name_weight" value="5">
      <input type="hidden" name="param_weight" value="3">
      <input type="hidden" name="doc_weight" value="2">
      <td align="right" style="padding-right: 4px;" id="search">
      <input name="query_string" onfocus="if(this.value=='Search API')this.value='';" onblur="if(this.value=='')this.value='Search API';" value="Search API">
      <input type="submit" value="Go">
      </td>
      </form>
      </tr>
      </table>
      </if>
      lib/toolbar.tcl 0 → 100644
      View file @ e1492d01
      # TODO: Handle the case when developer-support is not mounted
      set show_p [ds_show_p]
      if { $show_p } {
      set ds_url [ds_support_url]
      set comments_p [ds_comments_p]
      set comments_toggle_url [export_vars -base "${ds_url}comments-toggle" { { return_url [ad_return_url] } }]
      set comments_on [ad_decode $comments_p 1 "on" "off"]
      set num_comments [llength [ds_get_comments]]
      set user_switching_p [ds_user_switching_enabled_p]
      set user_switching_toggle_url [export_vars -base "${ds_url}set-user-switching-enabled" { { enabled_p {[expr !$user_switching_p]} } { return_url [ad_return_url] } }]
      set user_switching_on [ad_decode $user_switching_p 1 "on" "off"]
      set db_p [ds_database_enabled_p]
      set db_toggle_url [export_vars -base "${ds_url}set-database-enabled" { { enabled_p {[expr !$db_p]} } { return_url [ad_return_url] } }]
      set db_on [ad_decode $db_p 1 "on" "off"]
      set translator_p [lang::util::translator_mode_p]
      set translator_toggle_url [export_vars -base "/acs-lang/admin/translator-mode-toggle" { { return_url [ad_return_url] } }]
      set translator_on [ad_decode $translator_p 1 "on" "off"]
      set oacs_shell_url "${ds_url}shell"
      set auto_test_url [site_node::get_package_url -package_key acs-automated-testing]
      set request_info_url [export_vars -base "${ds_url}request-info" { { request {[ad_conn request]} } }]
      set page_ms [lc_numeric [ds_get_page_serve_time_ms]]
      set db_info [ds_get_db_command_info]
      set db_num_cmds [lindex $db_info 0]
      set db_num_ms [lc_numeric [lindex $db_info 1]]
      set flush_url [export_vars -base "/acs-admin/cache/flush-cache" { { suffix util_memoize } { return_url [ad_return_url] } }]
      if { [empty_string_p $page_ms] } {
      set request_info_label "Request info"
      } else {
      if { [empty_string_p $db_num_ms] } {
      set request_info_label "$page_ms ms"
      } else {
      set request_info_label "${page_ms} ms/${db_num_cmds} db/${db_num_ms} ms"
      }
      }
      }
      tcl/acs-developer-support-init.tcl 0 → 100644
      View file @ e1492d01
      # $Id$
      # File: developer-support-init.tcl
      # Author: Jon Salz <jsalz@mit.edu>
      # Date: 22 Apr 2000
      # Description: Provides routines used to aggregate request/response information for debugging.
      # Make sure we do the setup only once
      if { ![nsv_exists ds_properties enabled_p] } {
      ad_register_filter -critical t -priority 999999 trace * /* ds_trace_filter
      ad_schedule_proc [ad_parameter -package_id [ds_instance_id] DataSweepInterval acs-developer-support 900] ds_sweep_data
      nsv_array set ds_request [list]
      nsv_set ds_properties enabled_p [ad_parameter -package_id [ds_instance_id] EnabledOnStartupP acs-developer-support 0]
      # Take the IP list (space or comma seperated) and turn it into a tcl list.
      set IPs [list]
      foreach ip [split [ad_parameter -package_id [ds_instance_id] EnabledIPs acs-developer-support *] { ,}] {
      if {[string equal $ip "*"]} {
      # a star means anything will match so just use the * instead
      set IPs "*"
      break
      } elseif {![empty_string_p $ip]} {
      lappend IPs $ip
      }
      }
      nsv_set ds_properties enabled_ips $IPs
      nsv_set ds_properties database_enabled_p [ad_parameter -package_id [ds_instance_id] DatabaseEnabledP developer-support 0]
      ds_set_user_switching_enabled [ad_parameter -package_id [ds_instance_id] UserSwitchingEnabledP acs-developer-support 0]
      }
      ds_watch_packages
      tcl/acs-developer-support-procs-oracle.xql 0 → 100644
      View file @ e1492d01
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
      <fullquery name="ds_instance_id.acs_kernel_id_get">
      <querytext>
      select package_id from apm_packages
      where package_key = 'acs-developer-support'
      and rownum=1
      </querytext>
      </fullquery>
      <fullquery name="ds_require_permission.name">
      <querytext>
      select acs_object.name(:object_id) from dual
      </querytext>
      </fullquery>
      <fullquery name="ds_support_url.ds_support_url">
      <querytext>
      select site_node.url(node_id)
      from site_nodes s, apm_packages p
      where p.package_id = s.object_id
      and p.package_key ='acs-developer-support'
      and rownum = 1
      </querytext>
      </fullquery>
      <fullquery name="ds_user_select_widget.users">
      <querytext>
      select u.user_id as user_id_from_db,
      acs_object.name(user_id) as name,
      p.email
      from users u,
      parties p
      where u.user_id = p.party_id
      </querytext>
      </fullquery>
      </queryset>
      tcl/acs-developer-support-procs-postgresql.xql 0 → 100644
      View file @ e1492d01
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>postgresql</type><version>7.1</version></rdbms>
      <fullquery name="ds_instance_id.acs_kernel_id_get">
      <querytext>
      select package_id from apm_packages
      where package_key = 'acs-developer-support'
      limit 1
      </querytext>
      </fullquery>
      <fullquery name="ds_require_permission.name">
      <querytext>
      select acs_object__name(:object_id)
      </querytext>
      </fullquery>
      <fullquery name="ds_support_url.ds_support_url">
      <querytext>
      select site_node__url(node_id)
      from site_nodes s, apm_packages p
      where p.package_id = s.object_id
      and p.package_key ='acs-developer-support'
      limit 1
      </querytext>
      </fullquery>
      <fullquery name="ds_user_select_widget.users">
      <querytext>
      select u.user_id as user_id_from_db,
      acs_object__name(user_id) as name,
      p.email
      from users u,
      parties p
      where u.user_id = p.party_id
      </querytext>
      </fullquery>
      </queryset>
      tcl/acs-developer-support-procs.tcl 0 → 100644
      View file @ e1492d01
      This diff is collapsed.
      tcl/acs-developer-support-procs.xql 0 → 100644
      View file @ e1492d01
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="ds_user_select_widget.users">
      <querytext>
      select u.user_id as user_id_from_db,
      acs_object.name(user_id) as name,
      p.email
      from users u,
      parties p
      where u.user_id = p.party_id
      </querytext>
      </fullquery>
      </queryset>
      www/comments-toggle.tcl 0 → 100644
      View file @ e1492d01
      ad_page_contract {
      Toggle comments on/off
      } {
      return_url
      }
      if { [parameter::get -package_id [ds_instance_id] -parameter ShowCommentsInlineP -default 0] } {
      parameter::set_value -package_id [ds_instance_id] -parameter ShowCommentsInlineP -value 0
      } else {
      parameter::set_value -package_id [ds_instance_id] -parameter ShowCommentsInlineP -value 1
      }
      ad_returnredirect $return_url
      www/doc/developer-support-example.html 0 → 100644
      View file @ e1492d01
      This diff is collapsed.
      www/doc/index.html 0 → 100644
      View file @ e1492d01
      <html>
      <head>
      <title>Developer Support</title>
      </head>
      <body bgcolor=white text=black>
      <h2>Developer Support</h2>
      part of the <a href="">ArsDigita Community System</a>, by <a href="mailto:jsalz@mit.edu">Jon Salz</a>
      <hr>
      <ul>
      <li>Admin interface: /www/admin/monitoring/request-info.tcl
      <li>Procedures: /packages/developer-support-procs.tcl, with support in:
      <ul>
      <li>/tcl/ad-abstract-url.tcl
      <li>/tcl/ad-defs.tcl.preload
      <li>/tcl/ad-security.tcl.preload
      </ul>
      </ul>
      <h3>The Big Picture</h3>
      Software development is a big feedback loop: a developer writes something, tests it, and
      then repeats until the results are satisfactory. It's important to streamline this cycle
      by having a development environment which makes it easy to analyze what the software is
      doing under the hood.
      <h3>Peeking Under the Hood</h3>
      <p>Our development environment previously consisted largely of Emacs, and <tt>tail -f
      /web/servername/log/servername-error.log</tt>. Now this has been augmented:
      <tt>ad_footer</tt> and <tt>ad_admin_footer</tt> now display a link entitled
      <i>Developer Information</i>. (You can use the <tt>ds_link</tt> procedure to generate the
      link yourself.) Following the link displays a screenful of information
      including:
      <ul>
      <li>The times that the request started and ended, and its duration (with millisecond accuracy).
      <li>The request parameters (method, url, query, headers, etc.).
      <li>The output headers, if any.
      <li>Information about all database queries performed while loading the page, including
      their respective durations (with millisecond accuracy).
      </ul>
      <p>In addition, the ClientDebug facility of AOLserver 2 has been re-implemented in the
      abstract URL system (which serves nearly all non-static pages).
      If an error occurs while serving a page, a stack trace is printed out.
      <p>Note that these nifty features pop up only when you are logged in as a site-wide
      administrator! Revealing this information to anyone else would pose a huge security
      risk.
      <h3>Comments</h3>
      Tired of using <tt>ns_log</tt> to instrument your code, then grokking the error log
      to see what's wrong with your page? Use the <tt>ds_comment</tt> routine instead:
      <blockquote><pre>ds_comment "Foo is $foo"</pre></blockquote>
      Your comment will show up at the bottom of the page, beneath the <i>Developer Information</i>
      link (but only for site-wide administrators). It will also be displayed on the
      Developer Information page itself.
      <p>Comments are displayed even if an error occurs in the page!
      <h3>Enabling It</h3>
      Add the following to your
      <tt>parameters/yourservername.ini</tt> file:
      <blockquote><pre>[ns/server/yourservername/acs/developer-support]
      ; remember information about connections, for developers' benefit?
      EnabledP=1
      ; remember information about every database request?
      DatabaseEnabledP=1
      ; remember information for which client hosts?
      EnabledIPs=*
      ; remember this information for how long? sweep how often? (in seconds)
      DataLifetime=900
      DataSweepInterval=900</pre></blockquote>
      Note that you may not want to enable this stuff for production systems - they probably
      incur a slight performance hit (although this hasn't been benchmarked).
      <h3>How It Works</h3>
      The security subsystem registers preauth and trace filters which store relevant
      connection information in shared variables (<tt>nsv</tt>s). The security subsystem
      also renames the AOLserver <tt>ns_db</tt> procedure and registers a wrapper
      which aggregates information about database queries.
      <hr>
      <address><a href="mailto:jsalz@mit.edu">jsalz@mit.edu</a></address>
      <p>
      Last Modified: $Id$
      </p>
      </body>
      </html>
      www/index.adp 0 → 100644
      View file @ e1492d01
      <master>
      <property name="title">@page_title;noquote@</property>
      <property name="context">@context;noquote@</property>
      @body;noquote@
      www/index.tcl 0 → 100644
      View file @ e1492d01
      # File: index.tcl
      # Package: developer-support
      # Author: jsalz@mit.edu
      # Date: 22 June 2000
      # Description: Index page for developer support.
      #
      # $Id$
      ad_page_variables {
      { request_limit 25 }
      }
      ds_require_permission [ad_conn package_id] "admin"
      set enabled_p [nsv_get ds_properties enabled_p]
      set user_switching_enabled_p [nsv_get ds_properties user_switching_enabled_p]
      set database_enabled_p [nsv_get ds_properties database_enabled_p]
      set package_id [ad_conn package_id]
      set page_title "Developer Support"
      set context {}
      append body "
      <ul>
      <li><a href=\"shell.tcl\">OpenACS Shell</a>
      <li>Developer support toolbar is currently
      [ad_decode $enabled_p 1 \
      "on (<a href=\"set-enabled?enabled_p=0\">turn it off</a>)" \
      "off (<a href=\"set-enabled?enabled_p=1\">turn it on</a>)"]
      <li>Developer support information is currently
      restricted to the following IP addresses:
      <ul type=disc>
      "
      set enabled_ips [nsv_get ds_properties enabled_ips]
      set includes_this_ip_p 0
      if { [llength $enabled_ips] == 0 } {
      append body "<li><i>(none)</i>\n"
      } else {
      foreach ip $enabled_ips {
      if { [string match $ip [ad_conn peeraddr]] } {
      set includes_this_ip_p 1
      }
      if { [regexp {[\*\?\[\]]} $ip] } {
      append body "<li>IPs matching the pattern \"<code>$ip</code>\"\n"
      } else {
      append body "<li>$ip\n"
      }
      }
      }
      if { !$includes_this_ip_p } {
      append body "<li><a href=\"add-ip?ip=[ad_conn peeraddr]\">add your IP, [ad_conn peeraddr]</a>\n"
      }
      set requests [nsv_array names ds_request]
      append body "
      </ul>
      <li>Information is being swept every [ad_parameter DataSweepInterval "developer-support" 900] sec
      and has a lifetime of [ad_parameter DataLifetime "developer-support" 900] sec
      <li><a href=\"/shared/parameters?[export_vars { package_id { return_url {[ad_return_url]} } }]\">Set package parameters</a>
      <p>
      <li>User-switching is currently
      [ad_decode $user_switching_enabled_p 1 \
      "on (<a href=\"set-user-switching-enabled?enabled_p=0\">turn it off</a>)" \
      "off (<a href=\"set-user-switching-enabled?enabled_p=1\">turn it on</a>)"]
      <li>Database statistics is currently
      [ad_decode $database_enabled_p 1 \
      "on (<a href=\"set-database-enabled?enabled_p=0\">turn it off</a>)" \
      "off (<a href=\"set-database-enabled?enabled_p=1\">turn it on</a>)"]
      </ul>
      <h3>Available Request Information</h3>
      <blockquote>
      "
      if { [llength $requests] == 0 } {
      append body "There is no request information available."
      } else {
      append body "
      <table cellspacing=0 cellpadding=0>
      <tr bgcolor=#AAAAAA>
      <th>Time</th>
      <th>Duration</th>
      <th>IP</th>
      <th>Request</th>
      </tr>
      "
      set colors {white #EEEEEE}
      set counter 0
      set show_more 0
      foreach request [lsort -decreasing -dictionary $requests] {
      if { [regexp {^([0-9]+)\.conn$} $request "" id] } {
      if { $request_limit > 0 && $counter > $request_limit } {
      incr show_more
      continue
      }
      if { [info exists conn] } {
      unset conn
      }
      array set conn [nsv_get ds_request $request]
      if { [catch {
      set start [ns_fmttime [lindex [nsv_get ds_request "$id.start"] 0] "%T"]
      }] } {
      set start "?"
      }
      if { [info exists conn(startclicks)] && [info exists conn(endclicks)] } {
      set duration "[expr { ($conn(endclicks) - $conn(startclicks)) / 1000 }] ms"
      } else {
      set duration ""
      }
      if { [info exists conn(peeraddr)] } {
      set peeraddr $conn(peeraddr)
      } else {
      set peeraddr ""
      }
      if { [info exists conn(method)] } {
      set method $conn(method)
      } else {
      set method "?"
      }
      if { [info exists conn(url)] } {
      if { [string length $conn(url)] > 50 } {
      set url "[string range $conn(url) 0 46]..."
      } else {
      set url $conn(url)
      }
      } else {
      set conn(url) ""
      set url {}
      }
      if { [info exists conn(query)] && ![empty_string_p $conn(query)] } {
      if { [string length $conn(query)] > 50 } {
      set query "?[string range $conn(query) 0 46]..."
      } else {
      set query "?$conn(query)"
      }
      } else {
      set query ""
      }
      append body "
      <tr bgcolor=[lindex $colors [expr { $counter % [llength $colors] }]]>
      <td align=center>&nbsp;$start&nbsp;</td>
      <td align=right>&nbsp;$duration&nbsp;</td>
      <td>&nbsp;$peeraddr&nbsp;</td>
      <td><a href=\"request-info?request=$id\">[ns_quotehtml "$method $url$query"]</a></td>
      </tr>
      "
      incr counter
      }
      }
      if { $show_more > 0 } {
      append body "<tr><td colspan=4 align=right><a href=\"index?request_limit=0\"><i>show $show_more more requests</i></td></tr>\n"
      }
      append body "</table>\n"
      }
      append body "</blockquote>"
      www/request-info.adp 0 → 100644
      View file @ e1492d01
      <master>
      <property name="title">@page_title;noquote@</property>
      <property name="context">@context;noquote@</property>
      @body;noquote@
      <if @dbreqs:rowcount@ gt 0>
      <listfilters name="dbreqs" style="inline-filters"></listfilters>
      <listtemplate name="dbreqs"></listtemplate>
      </if>
      www/request-info.tcl 0 → 100644
      View file @ e1492d01
      # $Id$
      # File: request-info.tcl
      # Author: Jon Salz <jsalz@mit.edu>
      # Description: Displays information about a page request.
      # Inputs: request
      ad_page_contract {
      } {
      request
      {rp_show_debug_p 0}
      {getrow_p:boolean "f"}
      }
      ds_require_permission [ad_conn package_id] "admin"
      set page_title "Request Information"
      set context [list $page_title]
      foreach name [nsv_array names ds_request] {
      ns_log Debug "DS: Checking request $request, $name."
      if { [regexp {^([0-9]+)\.([a-z]+)$} $name "" m_request key] && $m_request == $request } {
      set property($key) [nsv_get ds_request $name]
      }
      }
      if { [info exists property(start)] } {
      append body "
      <h3>Parameters</h3>
      <blockquote>
      <table cellspacing=0 cellpadding=0>
      <tr><th align=left>Request Start Time:&nbsp;</th><td>[clock format [lindex $property(start) 0] -format "%Y-%m-%d %H:%M:%S"]\n"
      } else {
      append body "The information for this request is gone - either the server has been restarted, or
      the request is more than [ad_parameter DeveloperSupportLifetime "" 900] seconds old.
      [ad_admin_footer]"
      return
      }
      if { [info exists property(conn)] } {
      array set conn $property(conn)
      foreach { key name } {
      end {Request Completion Time}
      endclicks {Request Duration}
      peeraddr IP
      method Method
      url URL
      query Query
      user_id {User ID}
      session_id {Session ID}
      browser_id {Browser ID}
      validated {Session Validation}
      error {Error}
      } {
      if { [info exists conn($key)] } {
      switch $key {
      error {
      set value "<pre>[ns_quotehtml $conn($key)]</pre>"
      }
      endclicks {
      set value "[format "%.f" [expr { ($conn(endclicks) - $conn(startclicks)) / 1000 }]] ms"
      }
      end {
      set value [clock format $conn($key) -format "%Y-%m-%d %H:%M:%S" ]
      }
      user_id {
      if { [db_0or1row user_info "
      select first_names, last_name, email
      from users
      where user_id = $conn(user_id)
      "] } {
      set value "
      <a href=\"/shared/community-member?user_id=$conn(user_id)\">$conn(user_id)</a>:
      $first_names $last_name (<a href=\"mailto:$email\">mailto:$email</a>)
      "
      } else {
      set value $conn(user_id)
      }
      }
      default {
      set value [ns_quotehtml $conn($key)]
      }
      }
      append body "<tr valign=top><th align=left nowrap>$name:&nbsp;</th><td>[ad_decode $value "" "(empty)" $value]</td></tr>\n"
      }
      }
      }
      append body "</table></blockquote>"
      if { [info exists property(rp)] } {
      append body "
      <h3>Request Processor</h3>
      <ul>
      "
      foreach rp $property(rp) {
      set kind [lindex $rp 0]
      set info [lindex $rp 1]
      set startclicks [lindex $rp 2]
      set endclicks [lindex $rp 3]
      set action [lindex $rp 4]
      set error [lindex $rp 5]
      set duration "[format "%.1f" [expr { ($endclicks - $startclicks) / 1000.0 }]] ms"
      if { [string equal $kind debug] && !$rp_show_debug_p } {
      continue
      }
      if { [info exists conn(startclicks)] } {
      append body "<li>[format "%+.1f" [expr { ($startclicks - $conn(startclicks)) / 1000.0 }]] ms: "
      } else {
      append body "<li>"
      }
      switch $kind {
      transformation {
      set proc [lindex $info 0]
      set from [lindex $info 1]
      set to [lindex $info 2]
      # unlist $info proc from to
      if { [empty_string_p $to] } {
      set to "?"
      }
      append body "Applied transformation from <b>$from -> $to</b> - $duration\n"
      }
      filter {
      set kind [lindex $info 1]
      set method [lindex $info 2]
      set path [lindex $info 3]
      set proc [lindex $info 4]
      set args [lindex $info 5]
      append body "Applied $kind filter: <b>$proc</b> [ns_quotehtml $args] (for $method $path) - $duration\n"
      if { [string equal $action "error"] } {
      append body "<ul><li>returned error: <pre>[ns_quotehtml $error]</pre></ul>\n"
      } elseif { ![empty_string_p $action] } {
      append body "<ul><li>returned $action</ul>\n"
      }
      }
      registered_proc {
      set proc [lindex $info 2]
      set args [lindex $info 3]
      append body "Called registered procedure: <b>$proc</b> [ns_quotehtml $args] for ($method $path) - $duration\n"
      if { [string equal $action "error"] } {
      append body "<ul><li>returned error: <pre>[ns_quotehtml $error]</pre></ul>\n"
      }
      }
      serve_file {
      set file [lindex $info 0]
      set handler [lindex $info 1]
      append body "Served file <b>$file</b> with <b>$handler</b> - $duration\n"
      if { [string equal $action "error"] } {
      append body "<ul><li>returned error: <pre>[ns_quotehtml $error]</pre></ul>\n"
      }
      }
      notice {
      append body "$info\n"
      }
      debug {
      append body "<i>$info</i>\n"
      }
      }
      }
      if { !$rp_show_debug_p } {
      append body "<p><a href=\"request-info?[export_ns_set_vars url]&rp_show_debug_p=1\">show RP debugging information</a>"
      }
      append body "</ul>\n"
      }
      if { [info exists property(comment)] } {
      append body "<h3>Comments</h3><ul>\n"
      foreach comment $property(comment) {
      append body "<li>$comment\n"
      }
      append body "</ul>\n"
      }
      if { [info exists property(headers)] } {
      append body "<h3>Headers</h3>
      <blockquote><table cellspacing=0 cellpadding=0>\n"
      foreach { name value } $property(headers) {
      append body "<tr valign=top><th align=left>$name:&nbsp;</td><td>[ns_quotehtml $value]</td></tr>\n"
      }
      append body "</table></blockquote>\n"
      }
      if { [info exists property(oheaders)] } {
      append body "<h3>Output Headers</h3>
      <blockquote><table cellspacing=0 cellpadding=0>\n"
      foreach { name value } $property(oheaders) {
      append body "<tr valign=top><th align=left>$name:&nbsp;</td><td>[ns_quotehtml $value]</td></tr>\n"
      }
      append body "</table></blockquote>\n"
      }
      multirow create dbreqs handle command sql duration_ms value
      if { ![info exists property(db)] } {
      template::list::create \
      -name dbreqs \
      -elements { }
      } else {
      foreach { handle command statement_name sql start end errno return } $property(db) {
      if { ![empty_string_p $handle] && [info exists pool($handle)] } {
      set statement_pool $pool($handle)
      } else {
      set statement_pool ""
      }
      if { $command == "gethandle" } {
      # Remember which handle was acquired from which pool.
      set statement_pool $sql
      set value "gethandle (returned $return)"
      set pool($return) $sql
      } elseif { $command == "releasehandle" } {
      set value "releasehandle $handle"
      } else {
      if { [empty_string_p $statement_name] } {
      set value ""
      } else {
      set value "$statement_name: "
      }
      # Remove extra whitespace before query
      set min_whitespace -1
      foreach line [split $sql \n] {
      set len [string length $line]
      set trimleft_len [string length [string trimleft $line]]
      if { $trimleft_len > 0 } {
      set whitespace [expr $len - $trimleft_len]
      if { $min_whitespace == -1 || $whitespace < $min_whitespace } {
      set min_whitespace $whitespace
      }
      }
      }
      if { $min_whitespace > 0 } {
      set new_sql {}
      foreach line [split $sql \n] {
      append new_sql [string range $line $min_whitespace end] \n
      }
      set sql $new_sql
      }
      append value "$command $handle<pre>[ns_quotehtml $sql]</pre>"
      }
      if { ![string equal $command "getrow"] || [template::util::is_true $getrow_p] } {
      multirow append dbreqs $handle $command $sql [expr { $end - $start }] $value
      }
      }
      # TODO: Sort by duration, so you can see slowest queries at top
      template::list::create \
      -name dbreqs \
      -sub_class narrow \
      -elements {
      duration_ms {
      label "Duration"
      html { align right }
      display_template {@dbreqs.duration_ms@ ms}
      aggregate sum
      }
      command {
      label "Command"
      }
      sql {
      label "SQL"
      aggregate_label "Total Duration (ms)"
      display_template {@dbreqs.value;noquote@}
      }
      } -filters {
      getrow_p {
      label "Getrow"
      values {
      {"Include" t}
      {"Exclude" f}
      }
      default_value t
      }
      request {
      hide_p t
      }
      }
      }
      www/request-info.xql 0 → 100644
      View file @ e1492d01
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="user_info">
      <querytext>
      select first_names, last_name, email
      from users
      where user_id = $conn(user_id)
      </querytext>
      </fullquery>
      </queryset>
      www/set-database-enabled.tcl 0 → 100644
      View file @ e1492d01
      ad_page_contract {
      @author Lars Pind (lars@pinds.com)
      @creation-date 2003-10-28
      @cvs-id $Id$
      } {
      enabled_p
      {return_url "."}
      }
      ds_require_permission [ad_conn package_id] "admin"
      ds_set_database_enabled $enabled_p
      ad_returnredirect $return_url
      www/set-enabled.tcl 0 → 100644
      View file @ e1492d01
      # File: set-enabled.tcl
      # Package: developer-support
      # Author: jsalz@mit.edu
      # Date: 22 June 2000
      # Description: Enables or disables developer support data collection.
      #
      # $Id$
      ad_page_variables {
      enabled_p
      }
      ds_require_permission [ad_conn package_id] "admin"
      nsv_set ds_properties enabled_p $enabled_p
      ad_returnredirect "index"
      www/set-user-switching-enabled.tcl 0 → 100644
      View file @ e1492d01
      ad_page_contract {
      @author Lars Pind (lars@pinds.com)
      @creation-date 31 August 2000
      @cvs-id $Id$
      } {
      enabled_p
      {return_url "."}
      }
      ds_require_permission [ad_conn package_id] "admin"
      ds_set_user_switching_enabled $enabled_p
      ad_returnredirect $return_url
      www/set-user.tcl 0 → 100644
      View file @ e1492d01
      ad_page_contract {
      A hack that will allow us to simulate being a different user
      } {
      user_id:integer
      return_url
      }
      ##NOTE THIS DOESN'T REQUIRE ADMIN SO THAT WE CAN DO USER SWITCHING
      ad_require_permission [ad_conn package_id] "read"
      ad_set_client_property developer-support user_id $user_id
      ad_returnredirect $return_url
      www/shell.adp 0 → 100644
      View file @ e1492d01
      <master>
      <property name="title">@page_title;noquote@</property>
      <property name="context">@context;noquote@</property>
      <formtemplate id="shell"></formtemplate>
      <h3>Result</h3>
      <pre style="border: 1px solid black; padding: 4px">@result@</pre>
      www/shell.tcl 0 → 100644
      View file @ e1492d01
      ad_page_contract {
      @Author Nis Jorgensen
      } {
      {script:optional,allhtml {}}
      } -properties {
      result
      }
      ds_require_permission [ad_conn package_id] "admin"
      set page_title "OpenACS Shell"
      set context $page_title
      if { ![acs_user::site_wide_admin_p] } {
      ad_return_warning "Error" "Sorry, only site-wide admins may use this."
      ad_script_abort
      }
      set result ""
      ad_form -name shell -form {
      {
      script:text(textarea),nospell
      {label {Input tcl_script}}
      {html {cols 80 rows 10}}
      }
      } -on_submit {
      if {[catch {set result [uplevel 1 $script]}]} {
      global errorInfo
      set result "ERROR:\n$errorInfo"
      }
      }
      Markdown is supported
      0% or
      You are about to add 0 people to the discussion. Proceed with caution.
      Finish editing this message first!
      Please register or to comment